WIP implementation of teal_reportable

gogonzo · gogonzo · commit 9c498c176fc1 · 2025-05-27T14:26:20.000+02:00
diff --git a/R/tm_a_pca.R b/R/tm_a_pca.R
@@ -1038,9 +1038,8 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl
           data = q,
           decorators = select_decorators(decorators, obj_name),
           expr = reactive({
-            substitute(print(.plot), env = list(.plot = as.name(obj_name)))
-          }),
-          expr_is_reactive = TRUE
+            substitute(.plot, env = list(.plot = as.name(obj_name)))
+          })
         )
       },
       names(output_q),
diff --git a/R/tm_a_regression.R b/R/tm_a_regression.R
@@ -462,9 +462,11 @@ srv_a_regression <- function(id,
       )
     })
 
-    qenv <- reactive(
-      teal.code::eval_code(data(), 'library("ggplot2");library("dplyr")') # nolint quotes
-    )
+    qenv <- reactive({
+      obj <- data()
+      teal.reporter::report(obj) <- c(teal.reporter::report(obj), "# Module's computation")
+      teal.code::eval_code(obj, 'library("ggplot2");library("dplyr")') # nolint quotes
+    })
 
     anl_merged_q <- reactive({
       req(anl_merged_input())
@@ -991,16 +993,14 @@ srv_a_regression <- function(id,
         "Residuals vs Leverage" = output_plot_5(),
         "Cook's dist vs Leverage" = output_plot_6()
       )
-
-      teal.data::report(obj) <- c(teal.data::report(obj), "# Plot", obj[["plot"]])
       obj
     })
 
     decorated_output_q <- srv_decorate_teal_data(
       "decorator",
       data = output_q,
       decorators = select_decorators(decorators, "plot"),
-      expr = print(plot)
+      expr = quote(plot)
     )
 
     fitted <- reactive({
diff --git a/R/tm_g_association.R b/R/tm_g_association.R
@@ -525,10 +525,10 @@ srv_tm_g_association <- function(id,
       id = "decorator",
       data = output_q,
       decorators = select_decorators(decorators, "plot"),
-      expr = {
+      expr = quote({
         grid::grid.newpage()
         grid::grid.draw(plot)
-      }
+      })
     )
 
     plot_r <- reactive({
diff --git a/R/tm_g_bivariate.R b/R/tm_g_bivariate.R
@@ -711,7 +711,7 @@ srv_g_bivariate <- function(id,
         without_facet <- (is.null(nulled_row_facet_name) && is.null(nulled_col_facet_name)) || !facetting
 
         print_call <- if (without_facet) {
-          quote(print(plot))
+          quote(plot)
         } else {
           substitute(
             expr = {
@@ -730,8 +730,7 @@ srv_g_bivariate <- function(id,
           )
         }
         print_call
-      }),
-      expr_is_reactive = TRUE
+      })
     )
 
     plot_r <- reactive(req(decorated_output_q_facets())[["plot"]])
diff --git a/R/tm_g_distribution.R b/R/tm_g_distribution.R
@@ -1297,28 +1297,28 @@ srv_distribution <- function(id,
       "d_density",
       data = output_dist_q,
       decorators = select_decorators(decorators, "histogram_plot"),
-      expr = print(histogram_plot)
+      expr = quote(histogram_plot)
     )
 
     decorated_output_qq_q <- srv_decorate_teal_data(
       "d_qq",
       data = output_qq_q,
       decorators = select_decorators(decorators, "qq_plot"),
-      expr = print(qq_plot)
+      expr = quote(qq_plot)
     )
 
     decorated_output_summary_q <- srv_decorate_teal_data(
       "d_summary",
       data = output_summary_q,
       decorators = select_decorators(decorators, "summary_table"),
-      expr = summary_table
+      expr = quote(summary_table)
     )
 
     decorated_output_test_q <- srv_decorate_teal_data(
       "d_test",
       data = output_test_q,
       decorators = select_decorators(decorators, "test_table"),
-      expr = test_table
+      expr = quote(test_table)
     )
 
     decorated_output_q <- reactive({
diff --git a/R/tm_g_response.R b/R/tm_g_response.R
@@ -579,7 +579,7 @@ srv_g_response <- function(id,
       id = "decorator",
       data = output_q,
       decorators = select_decorators(decorators, "plot"),
-      expr = print(plot)
+      expr = quote(plot)
     )
 
     plot_r <- reactive(req(decorated_output_plot_q())[["plot"]])
diff --git a/R/tm_g_scatterplot.R b/R/tm_g_scatterplot.R
@@ -1023,7 +1023,7 @@ srv_g_scatterplot <- function(id,
       id = "decorator",
       data = output_q,
       decorators = select_decorators(decorators, "plot"),
-      expr = print(plot)
+      expr = quote(plot)
     )
 
     plot_r <- reactive(req(decorated_output_plot_q())[["plot"]])
diff --git a/R/tm_g_scatterplotmatrix.R b/R/tm_g_scatterplotmatrix.R
@@ -464,7 +464,7 @@ srv_g_scatterplotmatrix <- function(id,
       id = "decorator",
       data = output_q,
       decorators = select_decorators(decorators, "plot"),
-      expr = print(plot)
+      expr = quote(plot)
     )
 
     plot_r <- reactive(req(decorated_output_q())[["plot"]])
diff --git a/R/tm_missing_data.R b/R/tm_missing_data.R
@@ -1269,34 +1269,34 @@ srv_missing_data <- function(id,
       id = "dec_summary_plot",
       data = summary_plot_q,
       decorators = select_decorators(decorators, "summary_plot"),
-      expr = {
+      expr = quote({
         grid::grid.newpage()
         grid::grid.draw(summary_plot)
-      }
+      })
     )
 
     decorated_combination_plot_q <- srv_decorate_teal_data(
       id = "dec_combination_plot",
       data = combination_plot_q,
       decorators = select_decorators(decorators, "combination_plot"),
-      expr = {
+      expr = quote({
         grid::grid.newpage()
         grid::grid.draw(combination_plot)
-      }
+      })
     )
 
     decorated_summary_table_q <- srv_decorate_teal_data(
       id = "dec_summary_table",
       data = summary_table_q,
       decorators = select_decorators(decorators, "table"),
-      expr = table
+      expr = quote(table)
     )
 
     decorated_by_subject_plot_q <- srv_decorate_teal_data(
       id = "dec_by_subject_plot",
       data = by_subject_plot_q,
       decorators = select_decorators(decorators, "by_subject_plot"),
-      expr = print(by_subject_plot)
+      expr = quote(by_subject_plot)
     )
 
     # Plots & tables reactives
diff --git a/R/tm_outliers.R b/R/tm_outliers.R
@@ -1037,8 +1037,7 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var,
               },
               env = list(table_columns = input$table_ui_columns, .plot = as.name(obj_name))
             )
-          }),
-          expr_is_reactive = TRUE
+          })
         )
       },
       stats::setNames(nm = c("box_plot", "density_plot", "cumulative_plot")),
@@ -1051,7 +1050,7 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var,
       "d_table",
       data = decorated_final_q_no_table,
       decorators = select_decorators(decorators, "table"),
-      expr = table
+      expr = quote(table)
     )
 
     output$summary_table <- DT::renderDataTable(
diff --git a/R/tm_t_crosstable.R b/R/tm_t_crosstable.R
@@ -427,7 +427,7 @@ srv_t_crosstable <- function(id, data, reporter, filter_panel_api, label, x, y,
       id = "decorator",
       data = output_q,
       decorators = select_decorators(decorators, "table"),
-      expr = table
+      expr = quote(table)
     )
 
     output$title <- renderText(req(decorated_output_q())[["title"]])
diff --git a/R/utils.R b/R/utils.R
@@ -289,42 +289,36 @@ assert_single_selection <- function(x,
 #' @param expr (`expression` or `reactive`) to evaluate on the output of the decoration.
 #' When an expression it must be inline code. See [within()]
 #' Default is `NULL` which won't evaluate any appending code.
-#' @param expr_is_reactive (`logical(1)`) whether `expr` is a reactive expression
-#' that skips defusing the argument.
 #' @details
 #' `srv_decorate_teal_data` is a wrapper around `srv_transform_teal_data` that
 #' allows to decorate the data with additional expressions.
 #' When original `teal_data` object is in error state, it will show that error
 #' first.
 #'
 #' @keywords internal
-srv_decorate_teal_data <- function(id, data, decorators, expr, expr_is_reactive = FALSE) {
+srv_decorate_teal_data <- function(id, data, decorators, expr) {
   checkmate::assert_class(data, classes = "reactive")
   checkmate::assert_list(decorators, "teal_transform_module")
-  checkmate::assert_flag(expr_is_reactive)
-
-  missing_expr <- missing(expr)
-  if (!missing_expr && !expr_is_reactive) {
-    expr <- dplyr::enexpr(expr) # Using dplyr re-export to avoid adding rlang to Imports
-  }
+  expr_is_missing <- missing(expr)
 
   moduleServer(id, function(input, output, session) {
     decorated_output <- srv_transform_teal_data("inner", data = data, transformators = decorators)
 
+    expr_r <- reactive({
+      if (is.reactive(expr)) {
+        expr()
+      } else {
+        expr
+      }
+    })
+
     reactive({
-      data_out <- try(data(), silent = TRUE)
-      if (inherits(data_out, "qenv.error")) {
-        data()
+      req(data(), decorated_output())
+      if (expr_is_missing) {
+        decorated_output()
       } else {
-        # ensure original errors are displayed and `eval_code` is never executed with NULL
-        req(data(), decorated_output())
-        if (missing_expr) {
-          decorated_output()
-        } else if (expr_is_reactive) {
-          teal.code::eval_code(decorated_output(), expr())
-        } else {
-          teal.code::eval_code(decorated_output(), expr)
-        }
+        req(expr_r())
+        teal.code::eval_code(decorated_output(), expr_r(), cache = TRUE)
       }
     })
   })

Original file line number	Diff line number	Diff line change
`@@ -711,7 +711,7 @@ srv_g_bivariate <- function(id,`
`711`	`711`	`without_facet <- (is.null(nulled_row_facet_name) && is.null(nulled_col_facet_name)) \|\| !facetting`
`712`	`712`
`713`	`713`	`print_call <- if (without_facet) {`
`714`		`- quote(print(plot))`
	`714`	`+ quote(plot)`
`715`	`715`	`} else {`
`716`	`716`	`substitute(`
`717`	`717`	`expr = {`
`@@ -730,8 +730,7 @@ srv_g_bivariate <- function(id,`
`730`	`730`	`)`
`731`	`731`	`}`
`732`	`732`	`print_call`
`733`		`- }),`
`734`		`- expr_is_reactive = TRUE`
	`733`	`+ })`
`735`	`734`	`)`
`736`	`735`
`737`	`736`	`plot_r <- reactive(req(decorated_output_q_facets())[["plot"]])`
Original file line number	Diff line number	Diff line change
`@@ -579,7 +579,7 @@ srv_g_response <- function(id,`
`579`	`579`	`id = "decorator",`
`580`	`580`	`data = output_q,`
`581`	`581`	`decorators = select_decorators(decorators, "plot"),`
`582`		`- expr = print(plot)`
	`582`	`+ expr = quote(plot)`
`583`	`583`	`)`
`584`	`584`
`585`	`585`	`plot_r <- reactive(req(decorated_output_plot_q())[["plot"]])`
Original file line number	Diff line number	Diff line change
`@@ -1023,7 +1023,7 @@ srv_g_scatterplot <- function(id,`
`1023`	`1023`	`id = "decorator",`
`1024`	`1024`	`data = output_q,`
`1025`	`1025`	`decorators = select_decorators(decorators, "plot"),`
`1026`		`- expr = print(plot)`
	`1026`	`+ expr = quote(plot)`
`1027`	`1027`	`)`
`1028`	`1028`
`1029`	`1029`	`plot_r <- reactive(req(decorated_output_plot_q())[["plot"]])`
Original file line number	Diff line number	Diff line change
`@@ -464,7 +464,7 @@ srv_g_scatterplotmatrix <- function(id,`
`464`	`464`	`id = "decorator",`
`465`	`465`	`data = output_q,`
`466`	`466`	`decorators = select_decorators(decorators, "plot"),`
`467`		`- expr = print(plot)`
	`467`	`+ expr = quote(plot)`
`468`	`468`	`)`
`469`	`469`
`470`	`470`	`plot_r <- reactive(req(decorated_output_q())[["plot"]])`
Original file line number	Diff line number	Diff line change
`@@ -1037,8 +1037,7 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var,`
`1037`	`1037`	`},`
`1038`	`1038`	`env = list(table_columns = input$table_ui_columns, .plot = as.name(obj_name))`
`1039`	`1039`	`)`
`1040`		`- }),`
`1041`		`- expr_is_reactive = TRUE`
	`1040`	`+ })`
`1042`	`1041`	`)`
`1043`	`1042`	`},`
`1044`	`1043`	`stats::setNames(nm = c("box_plot", "density_plot", "cumulative_plot")),`
`@@ -1051,7 +1050,7 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var,`
`1051`	`1050`	`"d_table",`
`1052`	`1051`	`data = decorated_final_q_no_table,`
`1053`	`1052`	`decorators = select_decorators(decorators, "table"),`
`1054`		`- expr = table`
	`1053`	`+ expr = quote(table)`
`1055`	`1054`	`)`
`1056`	`1055`
`1057`	`1056`	`output$summary_table <- DT::renderDataTable(`