From da34ae42dd3f9d764422725148f38600f2a746ae Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Fri, 28 Mar 2025 07:21:04 +0000 Subject: [PATCH 01/50] feat: manual modules --- R/module_teal_data.R | 48 +------- R/module_validate.R | 259 +++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 260 insertions(+), 47 deletions(-) create mode 100644 R/module_validate.R diff --git a/R/module_teal_data.R b/R/module_teal_data.R index ff42ab84f3..42cccedde6 100644 --- a/R/module_teal_data.R +++ b/R/module_teal_data.R @@ -149,55 +149,9 @@ srv_validate_reactive_teal_data <- function(id, # nolint: object_length }) } -#' @keywords internal -ui_validate_error <- function(id) { - ns <- NS(id) - uiOutput(ns("message")) -} - -#' @keywords internal -srv_validate_error <- function(id, data, validate_shiny_silent_error) { - checkmate::assert_string(id) - checkmate::assert_flag(validate_shiny_silent_error) - moduleServer(id, function(input, output, session) { - output$message <- renderUI({ - is_shiny_silent_error <- inherits(data(), "shiny.silent.error") && identical(data()$message, "") - if (inherits(data(), "qenv.error")) { - validate( - need( - FALSE, - paste( - "Error when executing the `data` module:", - cli::ansi_strip(paste(data()$message, collapse = "\n")), - "\nCheck your inputs or contact app developer if error persists.", - collapse = "\n" - ) - ) - ) - } else if (inherits(data(), "error")) { - if (is_shiny_silent_error && !validate_shiny_silent_error) { - return(NULL) - } - validate( - need( - FALSE, - sprintf( - "Shiny error when executing the `data` module.\n%s\n%s", - data()$message, - "Check your inputs or contact app developer if error persists." - ) - ) - ) - } - }) - }) -} - - #' @keywords internal ui_check_class_teal_data <- function(id) { - ns <- NS(id) - uiOutput(ns("message")) + uiOutput(NS(id, "message")) } #' @keywords internal diff --git a/R/module_validate.R b/R/module_validate.R new file mode 100644 index 0000000000..eba160801a --- /dev/null +++ b/R/module_validate.R @@ -0,0 +1,259 @@ +#' @keywords internal +ui_validate_error <- function(id) { + ns <- NS(id) + # uiOutput(NS(id, ns("message"))) + tagList( + ui_module_validate_shinysilenterror(ns("validate_shinysilenterror")), + ui_module_validate_reactive(ns("validate_reactive")), + ui_module_validate_qenverror(ns("validate_qenverror")), + ui_module_validate_error(ns("validate_error")) + ) +} + +#' @keywords internal +srv_validate_error <- function(id, data, validate_shiny_silent_error) { + checkmate::assert_string(id) + checkmate::assert_flag(validate_shiny_silent_error) + moduleServer(id, function(input, output, session) { + srv_module_validate_shinysilenterror(data) + srv_module_validate_reactive(data) + srv_module_validate_qenverror(data) + srv_module_validate_error(data) + # output$message <- renderUI({ + # is_shiny_silent_error <- inherits(data(), "shiny.silent.error") && identical(data()$message, "") + # if (inherits(data(), "qenv.error")) { + # validate( + # need( + # FALSE, + # paste( + # "Error when executing the `data` module:", + # cli::ansi_strip(paste(data()$message, collapse = "\n")), + # "\nCheck your inputs or contact app developer if error persists.", + # collapse = "\n" + # ) + # ) + # ) + # } else if (inherits(data(), "error")) { + # if (is_shiny_silent_error && !validate_shiny_silent_error) { + # return(NULL) + # } + # validate( + # need( + # FALSE, + # sprintf( + # "Shiny error when executing the `data` module.\n%s\n%s", + # data()$message, + # "Check your inputs or contact app developer if error persists." + # ) + # ) + # ) + # } + # }) + }) +} + +# ############################################################################# +# +# _ _ _ _ _ _ +# | (_) | | | | | | (_) +# __ ____ _| |_ __| | __ _| |_ ___ _ __ ___ __ _ ___| |_ ___ _____ +# \ \ / / _` | | |/ _` |/ _` | __/ _ \ | '__/ _ \/ _` |/ __| __| \ \ / / _ \ +# \ V / (_| | | | (_| | (_| | || __/ | | | __/ (_| | (__| |_| |\ V / __/ +# \_/ \__,_|_|_|\__,_|\__,_|\__\___| |_| \___|\__,_|\___|\__|_| \_/ \___| +# +# +# +# validate reactive +# ############################################################################ + +srv_module_validate_reactive <- function(x, types = character(0L), null.ok = FALSE) { + moduleServer("validate_reactive", function(input, output, session) { + collection <- list() + collection <- append(collection, srv_module_check_reactive(x, types = types, null.ok = null.ok)) + + validate_r <- reactive({ + message_collection <- clean_collection(collection) + validate(need(length(message_collection) == 0, message_collection)) + TRUE + }) + + output$errors <- renderUI({ + validate_r() + NULL + }) + + + x + }) +} + +ui_module_validate_reactive <- function(id) uiOutput(NS(id, "errors")) + +srv_module_check_reactive <- function(x, types = character(0L), null.ok = FALSE) { + reactive_message <- check_reactive(x, null.ok = null.ok) + moduleServer("check_reactive", function(input, output, session) { + + reactive({ + if (isTRUE(reactive_message)) { + if (length(types) > 0 && !inherits(x(), types)) { + sprintf( + "Reactive value's class may only of the following types: %s, but it is '%s'", + paste("{", types, "}", sep = "", collapse = ", "), + class(x()) + ) + } else { + TRUE + } + } else { + reactive_message + } + }) + }) +} + +# ########################################################################### +# +# _ _ _ _ _ +# | | (_) (_) | | | +# ___| |__ _ _ __ _ _ ___ _| | ___ _ __ | |_ ___ _ __ _ __ ___ _ __ +# / __| '_ \| | '_ \| | | / __| | |/ _ \ '_ \| __/ _ \ '__| '__/ _ \| '__| +# \__ \ | | | | | | | |_| \__ \ | | __/ | | | || __/ | | | | (_) | | +# |___/_| |_|_|_| |_|\__, |___/_|_|\___|_| |_|\__\___|_| |_| \___/|_| +# __/ | +# |___/ +# +# shinysilenterror +# ########################################################################## + +srv_module_validate_shinysilenterror <- function(x) { + moduleServer("validate_shinysilenterror", function(input, output, session) { + collection <- list() + collection <- append(collection, srv_module_check_shinysilenterror(x)) + + validate_r <- reactive({ + message_collection <- clean_collection(collection) + validate(need(length(message_collection) == 0, message_collection)) + TRUE + }) + + output$errors <- renderUI({ + validate_r() + NULL + }) + + x + }) +} + +ui_module_validate_shinysilenterror <- function(id) uiOutput(NS(id, "errors")) + +srv_module_check_shinysilenterror <- function(x) { + moduleServer("check_shinysilenterror", function(input, output, session) { + reactive({ + if (inherits(x(), "shiny.silent.error") && identical(x()$message, "")) { + "Shiny silent error was raised" + } else { + TRUE + } + }) + }) +} + +# ############################################################### +# +# _ _ _ _ +# | (_) | | | | +# __ ____ _| |_ __| | __ _| |_ ___ __ _ ___ _ ____ __ +# \ \ / / _` | | |/ _` |/ _` | __/ _ \ / _` |/ _ \ '_ \ \ / / +# \ V / (_| | | | (_| | (_| | || __/ | (_| | __/ | | \ V / +# \_/ \__,_|_|_|\__,_|\__,_|\__\___| \__, |\___|_| |_|\_/ +# | | +# |_| +# +# validate qenv +# ############################################################## + +srv_module_validate_qenverror <- function(x) { + srv_module_validate_generic("validate_qenverror", srv_module_check_qenverror, x) +} + +ui_module_validate_qenverror <- function(id) uiOutput(NS(id, "errors")) + +srv_module_check_qenverror <- function(x) { + moduleServer("check_qenverror", function(input, output, session) { + + reactive({ + if (inherits(x(), "qenv.error")) { + c( + "Error when executing the `data` module:", + cli::ansi_strip(x()$message), + "", + "Check your inputs or contact app developer if error persists." + ) + } else { + TRUE + } + }) + }) +} + + +# + +srv_module_validate_error <- function(x) { + srv_module_validate_generic("validate_error", srv_module_check_error, x) +} + +ui_module_validate_error <- function(id) { + uiOutput(NS(id, "errors")) +} + +srv_module_check_error <- function(x) { + moduleServer("check_error", function(input, output, session) { + + reactive({ + if (inherits(x(), "error") && !inherits(x(), c("qenv.error", "shiny.silent.error"))) { + c("Error detected", x()$message) + } else { + TRUE + } + }) + }) +} + +# Aux + +srv_module_validate_generic <- function(id, fun, x, ...) { + moduleServer(id, function(input, output, session) { + collection <- list() + collection <- append(collection, fun(x, ...)) + + validate_r <- reactive({ + message_collection <- clean_collection(collection) + validate(need(length(message_collection) == 0, message_collection)) + TRUE + }) + + output$errors <- renderUI({ + validate_r() + NULL + }) + + x + }) +} + +clean_collection <- function(collection) { + Reduce( + function(u, v) { + el <- v() + if (isTRUE(el)) { + u + } else { + c(u, el) + } + }, + x = collection, + init = c() + ) +} From 738dd69b2332702a3bd50e56e5d334b428e37e6f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Fri, 28 Mar 2025 12:08:41 +0000 Subject: [PATCH 02/50] feat: stable factory creation --- DESCRIPTION | 1 + NAMESPACE | 5 + R/module_validate.R | 452 +++++++++++++++++++----- man/dot-substitute_template.Rd | 22 ++ man/module_validate_factory.Rd | 52 +++ man/module_validate_reactive.Rd | 41 +++ man/module_validate_shinysilenterror.Rd | 37 ++ teal.Rproj | 1 + 8 files changed, 515 insertions(+), 96 deletions(-) create mode 100644 man/dot-substitute_template.Rd create mode 100644 man/module_validate_factory.Rd create mode 100644 man/module_validate_reactive.Rd create mode 100644 man/module_validate_shinysilenterror.Rd diff --git a/DESCRIPTION b/DESCRIPTION index c6eb747e30..db457d3c0b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -120,6 +120,7 @@ Collate: 'module_teal_lockfile.R' 'module_teal_with_splash.R' 'module_transform_data.R' + 'module_validate.R' 'reporter_previewer_module.R' 'show_rcode_modal.R' 'tdata.R' diff --git a/NAMESPACE b/NAMESPACE index ac53893f97..e5321f1acb 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -28,11 +28,16 @@ export(modify_footer) export(modify_header) export(modify_title) export(module) +export(module_validate_factory) +export(module_validate_reactive) +export(module_validate_shinysilenterror) export(modules) export(new_tdata) export(report_card_template) export(reporter_previewer_module) export(show_rcode_modal) +export(srv_module_check_reactive) +export(srv_module_check_shinysilenterror) export(srv_session_info) export(srv_teal) export(srv_teal_with_splash) diff --git a/R/module_validate.R b/R/module_validate.R index eba160801a..e354b8f066 100644 --- a/R/module_validate.R +++ b/R/module_validate.R @@ -1,12 +1,10 @@ #' @keywords internal ui_validate_error <- function(id) { - ns <- NS(id) - # uiOutput(NS(id, ns("message"))) tagList( - ui_module_validate_shinysilenterror(ns("validate_shinysilenterror")), - ui_module_validate_reactive(ns("validate_reactive")), - ui_module_validate_qenverror(ns("validate_qenverror")), - ui_module_validate_error(ns("validate_error")) + module_validate_shinysilenterror$ui(id), + module_validate_reactive$ui(id), + module_validate_teal_data$ui(id), + module_validate_error$ui(id) ) } @@ -15,10 +13,13 @@ srv_validate_error <- function(id, data, validate_shiny_silent_error) { checkmate::assert_string(id) checkmate::assert_flag(validate_shiny_silent_error) moduleServer(id, function(input, output, session) { - srv_module_validate_shinysilenterror(data) - srv_module_validate_reactive(data) - srv_module_validate_qenverror(data) - srv_module_validate_error(data) + # New + module_validate_shinysilenterror$server(data) + module_validate_reactive$server(data, types = c("simpleError", "teal_data")) + module_validate_teal_data$server(data) + module_validate_error$server(data) + + # # Old # output$message <- renderUI({ # is_shiny_silent_error <- inherits(data(), "shiny.silent.error") && identical(data()$message, "") # if (inherits(data(), "qenv.error")) { @@ -52,27 +53,119 @@ srv_validate_error <- function(id, data, validate_shiny_silent_error) { }) } -# ############################################################################# + +# ####################################### # -# _ _ _ _ _ _ -# | (_) | | | | | | (_) -# __ ____ _| |_ __| | __ _| |_ ___ _ __ ___ __ _ ___| |_ ___ _____ -# \ \ / / _` | | |/ _` |/ _` | __/ _ \ | '__/ _ \/ _` |/ __| __| \ \ / / _ \ -# \ V / (_| | | | (_| | (_| | || __/ | | | __/ (_| | (__| |_| |\ V / __/ -# \_/ \__,_|_|_|\__,_|\__,_|\__\___| |_| \___|\__,_|\___|\__|_| \_/ \___| +# _ _ _ +# (_) | | | | +# _ _ __ | |_ ___ _ __ _ __ __ _| | +# | | '_ \| __/ _ \ '__| '_ \ / _` | | +# | | | | | || __/ | | | | | (_| | | +# |_|_| |_|\__\___|_| |_| |_|\__,_|_| # # # -# validate reactive -# ############################################################################ +# internal +# ###################################### + +#' Factory to build validate modules +#' +#' This function is used to create a module that validates the reactive data +#' passed to it. +#' +#' Dynamically generation of an `ui` and `server` function that can be used +#' internally in teal or in a teal module. +#' +#' +#' +#' @param module_id (`character(1)`) The module id. +#' @param ... (`function`) 1 or more [`shiny::moduleServer()`] functions that +#' return a [`shiny::reactive()`] with `TRUE` or a character string detailing +#' the excpetion. +#' It can be a named function, a character string or an anonymous function. +#' +#' @returns A list with `ui` and `server` functions with code generated from the +#' arguments. +#' +#' @examples +#' +#' check_error <- function(x, skip_on_empty_message = TRUE) { +#' moduleServer("check_error", function(input, output, session) { +#' reactive({ +#' if (inherits(x(), "error") && (!skip_on_empty_message || !identical(x()$message, ""))) { +#' c("Error detected", x()$message) +#' } else { +#' TRUE +#' } +#' }) +#' }) +#' } +#' +#' module_validate_factory("validate_error", check_error) +#' +#' check_numeric <- function(x, skip = FALSE) { +#' moduleServer("check_numeric", function(input, output, session) { +#' reactive(if (inherits(x(), numeric) || skip) TRUE else "Error: is not numeric") +#' }) +#' } +#' +#' module_validate_factory("validate_error", check_error, check_numeric) +#' @export +module_validate_factory <- function(module_id, ...) { + dots <- rlang::list2(...) + checkmate::check_list(dots, min.len = 1) + + fun_names <- match.call(expand.dots = FALSE)[["..."]] + + check_calls <- lapply( + seq_len(length(dots)), + function(fun_ix) { + fun_name <- fun_names[[fun_ix]] + fun_formals <- formals(dots[[fun_ix]]) + + substitute( + expr, + list( + expr = substitute( + collection <- append(collection, check_call), + list(check_call = rlang::call2(fun_name, !!!lapply(names(fun_formals), as.name))) + ) + ) + ) + } + ) -srv_module_validate_reactive <- function(x, types = character(0L), null.ok = FALSE) { - moduleServer("validate_reactive", function(input, output, session) { + top_level_formals <- Reduce( + function(u, v) { + new_formals <- formals(v) + common <- intersect(names(new_formals), names(u)) + vapply(common, function(x_name) { + if (identical(new_formals[[x_name]], u[[x_name]])) { + TRUE + } else { + stop("Arguments for check function have conflicting definitions (different defaults)") + } + }, FUN.VALUE = logical(1L)) + append(u, new_formals[setdiff(names(new_formals), names(u))]) + }, + init = list(), + x = dots + ) + + template_str = "check_calls" + + # Template moduleServer that supports multiple checks + module_server_body <- substitute({ collection <- list() - collection <- append(collection, srv_module_check_reactive(x, types = types, null.ok = null.ok)) + check_calls validate_r <- reactive({ - message_collection <- clean_collection(collection) + message_collection <- Reduce( + function(u, v) if (isTRUE(v())) u else c(u, v()), + x = collection, + init = c() + ) + validate(need(length(message_collection) == 0, message_collection)) TRUE }) @@ -82,13 +175,82 @@ srv_module_validate_reactive <- function(x, types = character(0L), null.ok = FAL NULL }) - x - }) + }, list(check_calls == as.name(template_str))) + + new_body_list <- .substitute_template(template_str, module_server_body, check_calls) + + server_body <- substitute({ + moduleServer(module_id, function(input, output, session) server_body) + }, list(module_id = module_id, server_body = new_body_list)) + + new_server_fun = function() TRUE + formals(new_server_fun) <- top_level_formals + body(new_server_fun) <- server_body + + new_ui_fun <- function(id) TRUE + body(new_ui_fun) <- substitute({ + ns <- NS(NS(id, module_id)) # id is defined at factory creation level + uiOutput(ns("errors")) + }, list(module_id = module_id)) + + list(ui = new_ui_fun, server = new_server_fun) } -ui_module_validate_reactive <- function(id) uiOutput(NS(id, "errors")) +#' Custom substitute function that injects multiple lines to an expression +#' +#' It must contain the `template_str` on the first level of the expression. +#' +#' @param template_str (`character(1)`) The call in the expression to be replaced. +#' @param module_server_body (`expression`) Any syntactically valid R expression. +#' @param check_calls (`list`) A list of expressions to be injected. +#' +#' @returns An expression with the `template_str` replaced by the `check_calls`. +#' +#' @keywords internal +.substitute_template <- function(template_str, module_server_body, check_calls) { + # Create server body with expressions for multiple checks + # note: using substitute directly will add curly braces around body + # todo: discuss this approach vs. having curly braces + body_list <- as.list(module_server_body)[-1] + ix <- which(body_list == as.name(template_str)) + + as.call( + c( + quote(`{`), + body_list[seq(1, ix - 1)], + check_calls, + body_list[seq(ix + 1, length(body_list))] + ) + ) +} +# ############################################################################# +# +# _ _ _ _ _ _ +# | (_) | | | | | | (_) +# __ ____ _| |_ __| | __ _| |_ ___ _ __ ___ __ _ ___| |_ ___ _____ +# \ \ / / _` | | |/ _` |/ _` | __/ _ \ | '__/ _ \/ _` |/ __| __| \ \ / / _ \ +# \ V / (_| | | | (_| | (_| | || __/ | | | __/ (_| | (__| |_| |\ V / __/ +# \_/ \__,_|_|_|\__,_|\__,_|\__\___| |_| \___|\__,_|\___|\__|_| \_/ \___| +# +# +# +# validate reactive +# ############################################################################ + +#' Validate if an argument is a reactive +#' +#' @param x (`reactive`) A reactive value. +#' @param types (`character`) A character vector with the types that the reactive. +#' @param null.ok (`logical`) If `TRUE`, the `x` argument can be `NULL`. +#' +#' @name module_validate_reactive +#' @seealso [module_validate_factory()] +#' +#' @returns A module that validates the reactive value. +#' +#' @export srv_module_check_reactive <- function(x, types = character(0L), null.ok = FALSE) { reactive_message <- check_reactive(x, null.ok = null.ok) moduleServer("check_reactive", function(input, output, session) { @@ -105,12 +267,26 @@ srv_module_check_reactive <- function(x, types = character(0L), null.ok = FALSE) TRUE } } else { - reactive_message + paste0("NEW: ", reactive_message) } }) }) } +#' @rdname module_validate_reactive +#' @param id (`character`) The module id. +#' @usage module_validate_reactive$server(x, types = character(0L), null.ok = FALSE) +#' module_validate_reactive$ui(id) +#' @examples +#' module_validate_reactive$ui("validate_reactive") +#' +#' # Show the generated server function +#' print(module_validate_reactive$server) +#' @export +module_validate_reactive <- module_validate_factory( + "validate_reactive", srv_module_check_reactive +) + # ########################################################################### # # _ _ _ _ _ @@ -125,33 +301,21 @@ srv_module_check_reactive <- function(x, types = character(0L), null.ok = FALSE) # shinysilenterror # ########################################################################## -srv_module_validate_shinysilenterror <- function(x) { - moduleServer("validate_shinysilenterror", function(input, output, session) { - collection <- list() - collection <- append(collection, srv_module_check_shinysilenterror(x)) - - validate_r <- reactive({ - message_collection <- clean_collection(collection) - validate(need(length(message_collection) == 0, message_collection)) - TRUE - }) - - output$errors <- renderUI({ - validate_r() - NULL - }) - - x - }) -} - -ui_module_validate_shinysilenterror <- function(id) uiOutput(NS(id, "errors")) - +#' Validate if an argument contains a `shiny.silent.error` +#' +#' @param x (`reactive`) A reactive value. +#' +#' @name module_validate_shinysilenterror +#' @seealso [module_validate_factory()] +#' +#' @returns A module that validates the reactive value. +#' +#' @export srv_module_check_shinysilenterror <- function(x) { moduleServer("check_shinysilenterror", function(input, output, session) { reactive({ if (inherits(x(), "shiny.silent.error") && identical(x()$message, "")) { - "Shiny silent error was raised" + "NEW: Shiny silent error was raised" } else { TRUE } @@ -159,33 +323,41 @@ srv_module_check_shinysilenterror <- function(x) { }) } -# ############################################################### +#' @rdname module_validate_shinysilenterror +#' @param id (`character`) The module id. +#' @usage module_validate_shinysilenterror$ui(id) +#' module_validate_shinysilenterror$server(x) +#' @examples +#' module_validate_shinysilenterror$ui("validate_reactive") +#' +#' # Show the generated server function +#' print(module_validate_shinysilenterror$server) +#' @export +module_validate_shinysilenterror <- module_validate_factory( + "validate_shinysilenterror", srv_module_check_shinysilenterror +) + +# ############################################################################### # -# _ _ _ _ -# | (_) | | | | -# __ ____ _| |_ __| | __ _| |_ ___ __ _ ___ _ ____ __ -# \ \ / / _` | | |/ _` |/ _` | __/ _ \ / _` |/ _ \ '_ \ \ / / -# \ V / (_| | | | (_| | (_| | || __/ | (_| | __/ | | \ V / -# \_/ \__,_|_|_|\__,_|\__,_|\__\___| \__, |\___|_| |_|\_/ -# | | -# |_| +# _ _ _ _ _ _ _ _ +# | (_) | | | | | | | | | | | | +# __ ____ _| |_ __| | __ _| |_ ___ | |_ ___ __ _| | __| | __ _| |_ __ _ +# \ \ / / _` | | |/ _` |/ _` | __/ _ \ | __/ _ \/ _` | | / _` |/ _` | __/ _` | +# \ V / (_| | | | (_| | (_| | || __/ | || __/ (_| | || (_| | (_| | || (_| | +# \_/ \__,_|_|_|\__,_|\__,_|\__\___| \__\___|\__,_|_| \__,_|\__,_|\__\__,_| +# ______ +# |______| # -# validate qenv -# ############################################################## +# validate teal_data +# ############################################################################## -srv_module_validate_qenverror <- function(x) { - srv_module_validate_generic("validate_qenverror", srv_module_check_qenverror, x) -} - -ui_module_validate_qenverror <- function(id) uiOutput(NS(id, "errors")) - -srv_module_check_qenverror <- function(x) { - moduleServer("check_qenverror", function(input, output, session) { +srv_module_check_teal_data <- function(x) { + moduleServer("check_teal_data", function(input, output, session) { reactive({ if (inherits(x(), "qenv.error")) { c( - "Error when executing the `data` module:", + "NEW: Error when executing the `data` module:", cli::ansi_strip(x()$message), "", "Check your inputs or contact app developer if error persists." @@ -197,23 +369,30 @@ srv_module_check_qenverror <- function(x) { }) } +module_validate_teal_data <- module_validate_factory( + "validate_teal_data", srv_module_check_teal_data +) +# ################################################################## # - -srv_module_validate_error <- function(x) { - srv_module_validate_generic("validate_error", srv_module_check_error, x) -} - -ui_module_validate_error <- function(id) { - uiOutput(NS(id, "errors")) -} +# _ _ _ _ +# | (_) | | | | +# __ ____ _| |_ __| | __ _| |_ ___ ___ _ __ _ __ ___ _ __ +# \ \ / / _` | | |/ _` |/ _` | __/ _ \ / _ \ '__| '__/ _ \| '__| +# \ V / (_| | | | (_| | (_| | || __/ | __/ | | | | (_) | | +# \_/ \__,_|_|_|\__,_|\__,_|\__\___| \___|_| |_| \___/|_| +# +# +# +# validate error +# ################################################################# srv_module_check_error <- function(x) { moduleServer("check_error", function(input, output, session) { reactive({ if (inherits(x(), "error") && !inherits(x(), c("qenv.error", "shiny.silent.error"))) { - c("Error detected", x()$message) + c("NEW: Error detected", x()$message) } else { TRUE } @@ -221,15 +400,42 @@ srv_module_check_error <- function(x) { }) } -# Aux +module_validate_error <- module_validate_factory( + "validate_error", srv_module_check_error +) -srv_module_validate_generic <- function(id, fun, x, ...) { - moduleServer(id, function(input, output, session) { +# ########################################## +# +# ___ +# |__ \ +# _ __ ___ _ __ ___ _____ _____ ) | +# | '__/ _ \ '_ ` _ \ / _ \ \ / / _ \/ / +# | | | __/ | | | | | (_) \ V / __/_| +# |_| \___|_| |_| |_|\___/ \_/ \___(_) +# +# +# +# todo: remove? +# ######################################### + +.substitute_template_curly <- function(template_str, module_server_body, check_calls) { + call_inject <- if (length(check_calls) > 1) { + as.call(c(quote(`{`), check_calls)) + } else { + as.call(check_calls[[1]]) + } + + vv <- substitute({ collection <- list() - collection <- append(collection, fun(x, ...)) + check_calls validate_r <- reactive({ - message_collection <- clean_collection(collection) + message_collection <- Reduce( + function(u, v) if (isTRUE(v())) u else c(u, v()), + x = collection, + init = c() + ) + validate(need(length(message_collection) == 0, message_collection)) TRUE }) @@ -240,20 +446,74 @@ srv_module_validate_generic <- function(id, fun, x, ...) { }) x - }) + }, list(check_calls = call_inject)) } -clean_collection <- function(collection) { - Reduce( - function(u, v) { - el <- v() - if (isTRUE(el)) { - u - } else { - c(u, el) - } +module_validate_factory_single <- function(module_id, check_fun) { + fun_name <- if (is.character(check_fun)) check_fun else deparse(substitute(check_fun)) + fun_formals <- formals(check_fun) + + server_body <- substitute( + { + moduleServer(module_id, function(input, output, session) { + collection <- list() + # todo: start with a req() of first argument + collection <- append(collection, check_call) + + validate_r <- reactive({ + message_collection <- Reduce( + function(u, v) if (isTRUE(v())) u else c(u, v()), + x = collection, + init = c() + ) + + validate(need(length(message_collection) == 0, message_collection)) + TRUE + }) + + output$errors <- renderUI({ + validate_r() + NULL + }) + + x + }) }, - x = collection, - init = c() + list( + # Generates call with exact formals of check function + check_call = rlang::call2(fun_name, !!!lapply(names(fun_formals), as.name)), + module_id = module_id + ) + ) + + new_server_fun = function() TRUE + formals(new_server_fun) <- formals(check_fun) + body(new_server_fun) <- server_body + + new_ui_fun <- function(id) TRUE + body(new_ui_fun) <- substitute( + { + uiOutput(NS(NS(id, module_id), "errors")) + }, + list(module_id = module_id) + ) + + list( + ui = new_ui_fun, + server = new_server_fun ) } + +######################################################################### +# +# _ __ ___ +# | | / _| |__ \ +# ___ _ __ __| | ___ | |_ _ __ ___ _ __ ___ _____ _____ ) | +# / _ \ '_ \ / _` | / _ \| _| | '__/ _ \ '_ ` _ \ / _ \ \ / / _ \/ / +# | __/ | | | (_| | | (_) | | | | | __/ | | | | | (_) \ V / __/_| +# \___|_| |_|\__,_| \___/|_| |_| \___|_| |_| |_|\___/ \_/ \___(_) +# +# +# +# end of remove? +# ######################################################################## diff --git a/man/dot-substitute_template.Rd b/man/dot-substitute_template.Rd new file mode 100644 index 0000000000..2a58d316f5 --- /dev/null +++ b/man/dot-substitute_template.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/module_validate.R +\name{.substitute_template} +\alias{.substitute_template} +\title{Custom substitute function that injects multiple lines to an expression} +\usage{ +.substitute_template(template_str, module_server_body, check_calls) +} +\arguments{ +\item{template_str}{(\code{character(1)}) The call in the expression to be replaced.} + +\item{module_server_body}{(\code{expression}) Any syntactically valid R expression.} + +\item{check_calls}{(\code{list}) A list of expressions to be injected.} +} +\value{ +An expression with the \code{template_str} replaced by the \code{check_calls}. +} +\description{ +It must contain the \code{template_str} on the first level of the expression. +} +\keyword{internal} diff --git a/man/module_validate_factory.Rd b/man/module_validate_factory.Rd new file mode 100644 index 0000000000..a8dcedb302 --- /dev/null +++ b/man/module_validate_factory.Rd @@ -0,0 +1,52 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/module_validate.R +\name{module_validate_factory} +\alias{module_validate_factory} +\title{Factory to build validate modules} +\usage{ +module_validate_factory(module_id, ...) +} +\arguments{ +\item{module_id}{(\code{character(1)}) The module id.} + +\item{...}{(\code{function}) 1 or more \code{\link[shiny:moduleServer]{shiny::moduleServer()}} functions that +return a \code{\link[shiny:reactive]{shiny::reactive()}} with \code{TRUE} or a character string detailing +the excpetion. +It can be a named function, a character string or an anonymous function.} +} +\value{ +A list with \code{ui} and \code{server} functions with code generated from the +arguments. +} +\description{ +This function is used to create a module that validates the reactive data +passed to it. +} +\details{ +Dynamically generation of an \code{ui} and \code{server} function that can be used +internally in teal or in a teal module. +} +\examples{ + +check_error <- function(x, skip_on_empty_message = TRUE) { + moduleServer("check_error", function(input, output, session) { + reactive({ + if (inherits(x(), "error") && (!skip_on_empty_message || !identical(x()$message, ""))) { + c("Error detected", x()$message) + } else { + TRUE + } + }) + }) +} + +module_validate_factory("validate_error", check_error) + +check_numeric <- function(x, skip = FALSE) { + moduleServer("check_numeric", function(input, output, session) { + reactive(if (inherits(x(), numeric) || skip) TRUE else "Error: is not numeric") + }) +} + +module_validate_factory("validate_error", check_error, check_numeric) +} diff --git a/man/module_validate_reactive.Rd b/man/module_validate_reactive.Rd new file mode 100644 index 0000000000..dd193c1acd --- /dev/null +++ b/man/module_validate_reactive.Rd @@ -0,0 +1,41 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/module_validate.R +\docType{data} +\name{module_validate_reactive} +\alias{module_validate_reactive} +\alias{srv_module_check_reactive} +\title{Validate if an argument is a reactive} +\format{ +An object of class \code{list} of length 2. +} +\usage{ +srv_module_check_reactive(x, types = character(0L), null.ok = FALSE) + +module_validate_reactive$server(x, types = character(0L), null.ok = FALSE) +module_validate_reactive$ui(id) +} +\arguments{ +\item{x}{(\code{reactive}) A reactive value.} + +\item{types}{(\code{character}) A character vector with the types that the reactive.} + +\item{null.ok}{(\code{logical}) If \code{TRUE}, the \code{x} argument can be \code{NULL}.} + +\item{id}{(\code{character}) The module id.} +} +\value{ +A module that validates the reactive value. +} +\description{ +Validate if an argument is a reactive +} +\examples{ +module_validate_reactive$ui("validate_reactive") + +# Show the generated server function +print(module_validate_reactive$server) +} +\seealso{ +\code{\link[=module_validate_factory]{module_validate_factory()}} +} +\keyword{datasets} diff --git a/man/module_validate_shinysilenterror.Rd b/man/module_validate_shinysilenterror.Rd new file mode 100644 index 0000000000..69ddb4d1ad --- /dev/null +++ b/man/module_validate_shinysilenterror.Rd @@ -0,0 +1,37 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/module_validate.R +\docType{data} +\name{module_validate_shinysilenterror} +\alias{module_validate_shinysilenterror} +\alias{srv_module_check_shinysilenterror} +\title{Validate if an argument contains a \code{shiny.silent.error}} +\format{ +An object of class \code{list} of length 2. +} +\usage{ +srv_module_check_shinysilenterror(x) + +module_validate_shinysilenterror$ui(id) +module_validate_shinysilenterror$server(x) +} +\arguments{ +\item{x}{(\code{reactive}) A reactive value.} + +\item{id}{(\code{character}) The module id.} +} +\value{ +A module that validates the reactive value. +} +\description{ +Validate if an argument contains a \code{shiny.silent.error} +} +\examples{ +module_validate_shinysilenterror$ui("validate_reactive") + +# Show the generated server function +print(module_validate_shinysilenterror$server) +} +\seealso{ +\code{\link[=module_validate_factory]{module_validate_factory()}} +} +\keyword{datasets} diff --git a/teal.Rproj b/teal.Rproj index ab99014abb..dc9baae320 100644 --- a/teal.Rproj +++ b/teal.Rproj @@ -1,4 +1,5 @@ Version: 1.0 +ProjectId: e5118e65-0c4b-46e6-ac30-08a55e0c5e8c RestoreWorkspace: Default SaveWorkspace: Default From b6b72aa469d72db0fddec99224531991edd526fb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Fri, 28 Mar 2025 17:52:28 +0000 Subject: [PATCH 03/50] broken: shinysilent not triggering --- R/module_nested_tabs.R | 2 +- R/module_teal_data.R | 46 ++++++------ R/module_validate.R | 126 ++++++++++++++++++++++----------- R/zzz.R | 2 + inst/css/validation.css | 21 ++++++ man/module_validate_factory.Rd | 10 +-- 6 files changed, 139 insertions(+), 68 deletions(-) diff --git a/R/module_nested_tabs.R b/R/module_nested_tabs.R index 59e819a2a0..8544fbad12 100644 --- a/R/module_nested_tabs.R +++ b/R/module_nested_tabs.R @@ -367,7 +367,7 @@ srv_teal_module.teal_module <- function(id, srv_check_module_datanames( "validate_datanames", - data = module_teal_data, + x = module_teal_data, modules = modules ) diff --git a/R/module_teal_data.R b/R/module_teal_data.R index 42cccedde6..84fd99e376 100644 --- a/R/module_teal_data.R +++ b/R/module_teal_data.R @@ -169,28 +169,30 @@ srv_check_class_teal_data <- function(id, data) { }) } -#' @keywords internal -ui_check_module_datanames <- function(id) { - ns <- NS(id) - uiOutput(NS(id, "message")) -} - -#' @keywords internal -srv_check_module_datanames <- function(id, data, modules) { - checkmate::assert_string(id) - moduleServer(id, function(input, output, session) { - output$message <- renderUI({ - if (inherits(data(), "teal_data")) { - is_modules_ok <- check_modules_datanames_html( - modules = modules, datanames = names(data()) - ) - if (!isTRUE(is_modules_ok)) { - tags$div(is_modules_ok, class = "teal-output-warning") - } - } - }) - }) -} +# See R/module_validate.R + +# #' @keywords internal +# ui_check_module_datanames <- function(id) { +# ns <- NS(id) +# uiOutput(NS(id, "message")) +# } + +# #' @keywords internal +# srv_check_module_datanames <- function(id, data, modules) { +# checkmate::assert_string(id) +# moduleServer(id, function(input, output, session) { +# output$message <- renderUI({ +# if (inherits(data(), "teal_data")) { +# is_modules_ok <- check_modules_datanames_html( +# modules = modules, datanames = names(data()) +# ) +# if (!isTRUE(is_modules_ok)) { +# tags$div(is_modules_ok, class = "teal-output-warning") +# } +# } +# }) +# }) +# } .trigger_on_success <- function(data) { out <- reactiveVal(NULL) diff --git a/R/module_validate.R b/R/module_validate.R index e354b8f066..35bbef5c25 100644 --- a/R/module_validate.R +++ b/R/module_validate.R @@ -1,10 +1,11 @@ #' @keywords internal ui_validate_error <- function(id) { + ns <- NS(id) tagList( - module_validate_shinysilenterror$ui(id), - module_validate_reactive$ui(id), - module_validate_teal_data$ui(id), - module_validate_error$ui(id) + module_validate_shinysilenterror$ui(ns("validate_shinysilenterror")), + module_validate_reactive$ui(ns("validate_reactive")), + module_validate_teal_data$ui(ns("validate_teal_data")), + module_validate_error$ui(ns("validate_error")) ) } @@ -14,10 +15,13 @@ srv_validate_error <- function(id, data, validate_shiny_silent_error) { checkmate::assert_flag(validate_shiny_silent_error) moduleServer(id, function(input, output, session) { # New - module_validate_shinysilenterror$server(data) - module_validate_reactive$server(data, types = c("simpleError", "teal_data")) - module_validate_teal_data$server(data) - module_validate_error$server(data) + module_validate_shinysilenterror$server("validate_shinysilent_error", data) + # module_validate_reactive$server("validate_reactive", data) + # module_validate_teal_data$server("validate_teal_Data", data) + # module_validate_error$server("validate_error", data) + + # # Uncomment line below and choose "validate error" + # module_validate_reactive$server("validate_reactive", data, types = c("simpleError", "teal_data")) # # Old # output$message <- renderUI({ @@ -101,7 +105,7 @@ srv_validate_error <- function(id, data, validate_shiny_silent_error) { #' }) #' } #' -#' module_validate_factory("validate_error", check_error) +#' module_validate_factory(check_error) #' #' check_numeric <- function(x, skip = FALSE) { #' moduleServer("check_numeric", function(input, output, session) { @@ -109,9 +113,9 @@ srv_validate_error <- function(id, data, validate_shiny_silent_error) { #' }) #' } #' -#' module_validate_factory("validate_error", check_error, check_numeric) +#' module_validate_factory(check_error, check_numeric) #' @export -module_validate_factory <- function(module_id, ...) { +module_validate_factory <- function(...) { dots <- rlang::list2(...) checkmate::check_list(dots, min.len = 1) @@ -135,6 +139,8 @@ module_validate_factory <- function(module_id, ...) { } ) + new_server_fun = function(id) TRUE + top_level_formals <- Reduce( function(u, v) { new_formals <- formals(v) @@ -148,7 +154,7 @@ module_validate_factory <- function(module_id, ...) { }, FUN.VALUE = logical(1L)) append(u, new_formals[setdiff(names(new_formals), names(u))]) }, - init = list(), + init = formals(new_server_fun), x = dots ) @@ -161,18 +167,33 @@ module_validate_factory <- function(module_id, ...) { validate_r <- reactive({ message_collection <- Reduce( - function(u, v) if (isTRUE(v())) u else c(u, v()), + function(u, v) if (isTRUE(v()) || is.null(v())) u else append(u, list(v())), x = collection, - init = c() + init = list() ) - - validate(need(length(message_collection) == 0, message_collection)) - TRUE + message_collection }) output$errors <- renderUI({ - validate_r() - NULL + error_class <- c("shiny.silent.error", "validation", "error", "condition") + if (length(validate_r()) > 0) { + # Custom rendering of errors instead of validate + # this allows for more control over the output (as some show errors in + # html) + tagList( + !!!lapply( + validate_r(), + function(.x) { + html_class <- if (isTRUE(attr(.x[1], "is_warning")) || isTRUE(attr(.x, "is_warning"))) { + "teal-output-warning" + } else { + "shiny-output-error" + } + tags$div(class = html_class, tags$div(lapply(.x, tags$p))) + } + ) + ) + } }) x @@ -181,19 +202,15 @@ module_validate_factory <- function(module_id, ...) { new_body_list <- .substitute_template(template_str, module_server_body, check_calls) server_body <- substitute({ - moduleServer(module_id, function(input, output, session) server_body) - }, list(module_id = module_id, server_body = new_body_list)) + moduleServer(id, function(input, output, session) server_body) + }, list(server_body = new_body_list)) - new_server_fun = function() TRUE formals(new_server_fun) <- top_level_formals body(new_server_fun) <- server_body - new_ui_fun <- function(id) TRUE - body(new_ui_fun) <- substitute({ - ns <- NS(NS(id, module_id)) # id is defined at factory creation level - uiOutput(ns("errors")) - }, list(module_id = module_id)) + new_ui_fun <- function(id) uiOutput(NS(id, "errors")) + # todo: check if body need list(ui = new_ui_fun, server = new_server_fun) } @@ -225,6 +242,42 @@ module_validate_factory <- function(module_id, ...) { ) } +# ########################################################################## +# +# _ _ +# | | | | +# __ __ __| | __ _| |_ __ _ _ __ __ _ _ __ ___ ___ ___ +# \ \ / / / _` |/ _` | __/ _` | '_ \ / _` | '_ ` _ \ / _ \/ __| +# \ V / | (_| | (_| | || (_| | | | | (_| | | | | | | __/\__ \ +# \_/ \__,_|\__,_|\__\__,_|_| |_|\__,_|_| |_| |_|\___||___/ +# ______ +# |______| +# +# v_datanames +# ######################################################################### + +#' @keywords internal +srv_module_check_datanames <- function(id, x, modules) { + checkmate::assert_string(id) + moduleServer(id, function(input, output, session) { + reactive({ + if (inherits(x(), "teal_data")) { + is_modules_ok <- check_modules_datanames_html( + modules = modules, datanames = names(x()) + ) + attr(is_modules_ok, "is_warning") <- TRUE + is_modules_ok + } else { + TRUE # Error handled elsewhere (avoids showing) + } + }) + }) +} + +module_validate_datanames <- module_validate_factory(srv_module_check_datanames) +srv_check_module_datanames <- module_validate_datanames$server +ui_check_module_datanames <- module_validate_datanames$ui + # ############################################################################# # # _ _ _ _ _ _ @@ -261,7 +314,7 @@ srv_module_check_reactive <- function(x, types = character(0L), null.ok = FALSE) sprintf( "Reactive value's class may only of the following types: %s, but it is '%s'", paste("{", types, "}", sep = "", collapse = ", "), - class(x()) + paste("{", class(x()), "}", sep = "", collapse = ", ") ) } else { TRUE @@ -283,9 +336,7 @@ srv_module_check_reactive <- function(x, types = character(0L), null.ok = FALSE) #' # Show the generated server function #' print(module_validate_reactive$server) #' @export -module_validate_reactive <- module_validate_factory( - "validate_reactive", srv_module_check_reactive -) +module_validate_reactive <- module_validate_factory(srv_module_check_reactive) # ########################################################################### # @@ -314,6 +365,7 @@ module_validate_reactive <- module_validate_factory( srv_module_check_shinysilenterror <- function(x) { moduleServer("check_shinysilenterror", function(input, output, session) { reactive({ + browser() if (inherits(x(), "shiny.silent.error") && identical(x()$message, "")) { "NEW: Shiny silent error was raised" } else { @@ -333,9 +385,7 @@ srv_module_check_shinysilenterror <- function(x) { #' # Show the generated server function #' print(module_validate_shinysilenterror$server) #' @export -module_validate_shinysilenterror <- module_validate_factory( - "validate_shinysilenterror", srv_module_check_shinysilenterror -) +module_validate_shinysilenterror <- module_validate_factory(srv_module_check_shinysilenterror) # ############################################################################### # @@ -369,9 +419,7 @@ srv_module_check_teal_data <- function(x) { }) } -module_validate_teal_data <- module_validate_factory( - "validate_teal_data", srv_module_check_teal_data -) +module_validate_teal_data <- module_validate_factory(srv_module_check_teal_data) # ################################################################## # @@ -400,9 +448,7 @@ srv_module_check_error <- function(x) { }) } -module_validate_error <- module_validate_factory( - "validate_error", srv_module_check_error -) +module_validate_error <- module_validate_factory(srv_module_check_error) # ########################################## # diff --git a/R/zzz.R b/R/zzz.R index 62c8029561..003218b72b 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -25,6 +25,8 @@ # we avoid `desc` dependency here to get the version read.dcf(system.file("DESCRIPTION", package = "teal"))[, "Version"] ) + + if (version$minor < 4) `%||%` <<- rlang::`%||%` } # This one is here because setdiff_teal_slice should not be exported from teal.slice. diff --git a/inst/css/validation.css b/inst/css/validation.css index 665fac2d73..82e22b02bc 100644 --- a/inst/css/validation.css +++ b/inst/css/validation.css @@ -15,23 +15,44 @@ .teal_validated .shiny-output-error, .teal_validated .teal-output-warning { + display: flex; margin-top: 0.5em; + margin-bottom: 0.5em; +} + +.teal_validated .shiny-output-error > div, +.teal_validated .teal-output-warning > div { + display: flex; + flex-direction: column; +} + +.teal_validated .shiny-output-error p, +.teal_validated .teal-output-warning p{ + margin-bottom: 0; } .teal_validated .teal-output-warning::before { content: "\26A0\FE0F"; + padding-left: 0.3em; + padding-right: 0.3em; } .teal_validated .shiny-output-error::before { content: "\1F6A8"; + padding-left: 0.3em; + padding-right: 0.3em; } .teal_primary_col .shiny-output-error::before { content: "\1F6A8"; + padding-left: 0.3em; + padding-right: 0.3em; } .teal_primary_col .teal-output-warning::before { content: "\26A0\FE0F"; + padding-left: 0.3em; + padding-right: 0.3em; } .teal_primary_col .teal_validated:has(.shiny-output-error), diff --git a/man/module_validate_factory.Rd b/man/module_validate_factory.Rd index a8dcedb302..ef18d6be65 100644 --- a/man/module_validate_factory.Rd +++ b/man/module_validate_factory.Rd @@ -4,15 +4,15 @@ \alias{module_validate_factory} \title{Factory to build validate modules} \usage{ -module_validate_factory(module_id, ...) +module_validate_factory(...) } \arguments{ -\item{module_id}{(\code{character(1)}) The module id.} - \item{...}{(\code{function}) 1 or more \code{\link[shiny:moduleServer]{shiny::moduleServer()}} functions that return a \code{\link[shiny:reactive]{shiny::reactive()}} with \code{TRUE} or a character string detailing the excpetion. It can be a named function, a character string or an anonymous function.} + +\item{module_id}{(\code{character(1)}) The module id.} } \value{ A list with \code{ui} and \code{server} functions with code generated from the @@ -40,7 +40,7 @@ check_error <- function(x, skip_on_empty_message = TRUE) { }) } -module_validate_factory("validate_error", check_error) +module_validate_factory(check_error) check_numeric <- function(x, skip = FALSE) { moduleServer("check_numeric", function(input, output, session) { @@ -48,5 +48,5 @@ check_numeric <- function(x, skip = FALSE) { }) } -module_validate_factory("validate_error", check_error, check_numeric) +module_validate_factory(check_error, check_numeric) } From 2527887c0f58b11039530a4c70ca9cf8708e7f51 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Mon, 31 Mar 2025 14:45:10 +0100 Subject: [PATCH 04/50] fix: problem with shiny.silent.error id name --- R/module_validate.R | 46 ++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 41 insertions(+), 5 deletions(-) diff --git a/R/module_validate.R b/R/module_validate.R index 35bbef5c25..2efd72583c 100644 --- a/R/module_validate.R +++ b/R/module_validate.R @@ -2,7 +2,8 @@ ui_validate_error <- function(id) { ns <- NS(id) tagList( - module_validate_shinysilenterror$ui(ns("validate_shinysilenterror")), + module_validate_shinysilenterror$ui(ns("validate_shinysilent_error")), + module_validate_shinysilenterror$ui(ns("validate_validation_error")), module_validate_reactive$ui(ns("validate_reactive")), module_validate_teal_data$ui(ns("validate_teal_data")), module_validate_error$ui(ns("validate_error")) @@ -16,9 +17,10 @@ srv_validate_error <- function(id, data, validate_shiny_silent_error) { moduleServer(id, function(input, output, session) { # New module_validate_shinysilenterror$server("validate_shinysilent_error", data) - # module_validate_reactive$server("validate_reactive", data) - # module_validate_teal_data$server("validate_teal_Data", data) - # module_validate_error$server("validate_error", data) + module_validate_validation_error$server("validate_validation_error", data) + module_validate_reactive$server("validate_reactive", data) + module_validate_teal_data$server("validate_teal_Data", data) + module_validate_error$server("validate_error", data) # # Uncomment line below and choose "validate error" # module_validate_reactive$server("validate_reactive", data, types = c("simpleError", "teal_data")) @@ -202,6 +204,7 @@ module_validate_factory <- function(...) { new_body_list <- .substitute_template(template_str, module_server_body, check_calls) server_body <- substitute({ + assert_reactive(x) moduleServer(id, function(input, output, session) server_body) }, list(server_body = new_body_list)) @@ -352,6 +355,40 @@ module_validate_reactive <- module_validate_factory(srv_module_check_reactive) # shinysilenterror # ########################################################################## +#' Validate if an argument contains a `shiny.silent.error` validation error +#' +#' @param x (`reactive`) A reactive value. +#' +#' @name module_validate_shinysilenterror +#' @seealso [module_validate_factory()] +#' +#' @returns A module that validates the reactive value. +#' +#' @export +srv_module_check_validation_error <- function(x) { + moduleServer("check_validation_error", function(input, output, session) { + reactive({ + if (checkmate::test_class(x(), c("shiny.silent.error", "validation")) && !identical(x()$message, "")) { + sprintf("NEW: Shiny validation error was raised: %s", x()$message) + } else { + TRUE + } + }) + }) +} + +#' @rdname module_validate_shinysilenterror +#' @param id (`character`) The module id. +#' @usage module_validate_shinysilenterror$ui(id) +#' module_validate_shinysilenterror$server(x) +#' @examples +#' module_validate_shinysilenterror$ui("validate_reactive") +#' +#' # Show the generated server function +#' print(module_validate_shinysilenterror$server) +#' @export +module_validate_validation_error <- module_validate_factory(srv_module_check_validation_error) + #' Validate if an argument contains a `shiny.silent.error` #' #' @param x (`reactive`) A reactive value. @@ -365,7 +402,6 @@ module_validate_reactive <- module_validate_factory(srv_module_check_reactive) srv_module_check_shinysilenterror <- function(x) { moduleServer("check_shinysilenterror", function(input, output, session) { reactive({ - browser() if (inherits(x(), "shiny.silent.error") && identical(x()$message, "")) { "NEW: Shiny silent error was raised" } else { From 970838538617671678bd399847dc07014632b1c8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Mon, 31 Mar 2025 15:10:01 +0100 Subject: [PATCH 05/50] chore: cleanup --- R/module_nested_tabs.R | 4 +- R/module_teal.R | 8 +- R/module_teal_data.R | 51 +--------- R/module_transform_data.R | 8 +- R/module_validate.R | 205 +++++++++++++++++++------------------- 5 files changed, 119 insertions(+), 157 deletions(-) diff --git a/R/module_nested_tabs.R b/R/module_nested_tabs.R index 8544fbad12..2836b7c030 100644 --- a/R/module_nested_tabs.R +++ b/R/module_nested_tabs.R @@ -109,7 +109,7 @@ ui_teal_module.teal_module <- function(id, modules, depth = 0L) { id = ns("teal_module_ui"), tags$div( class = "teal_validated", - ui_check_module_datanames(ns("validate_datanames")) + module_validate_datanames$ui(ns("validate_datanames")) ), do.call(what = modules$ui, args = args, quote = TRUE) ) @@ -365,7 +365,7 @@ srv_teal_module.teal_module <- function(id, all_teal_data[c(module_datanames, ".raw_data")] }) - srv_check_module_datanames( + module_validate_datanames$server( "validate_datanames", x = module_teal_data, modules = modules diff --git a/R/module_teal.R b/R/module_teal.R index 18d5c8fde2..4aa691cecd 100644 --- a/R/module_teal.R +++ b/R/module_teal.R @@ -139,13 +139,13 @@ srv_teal <- function(id, data, modules, filter = teal_slices()) { validate_ui <- tags$div( id = session$ns("validate_messages"), class = "teal_validated", - ui_check_class_teal_data(session$ns("class_teal_data")), + module_validate_teal_data$ui(session$ns("class_teal_data")), ui_validate_error(session$ns("silent_error")), - ui_check_module_datanames(session$ns("datanames_warning")) + module_validate_datanames$ui(session$ns("datanames_warning")) ) - srv_check_class_teal_data("class_teal_data", data_handled) + module_validate_teal_data$server("class_teal_data", data_handled) srv_validate_error("silent_error", data_handled, validate_shiny_silent_error = FALSE) - srv_check_module_datanames("datanames_warning", data_handled, modules) + module_validate_datanames$server("datanames_warning", data_handled, modules) data_validated <- .trigger_on_success(data_handled) diff --git a/R/module_teal_data.R b/R/module_teal_data.R index 84fd99e376..7cd0c4f347 100644 --- a/R/module_teal_data.R +++ b/R/module_teal_data.R @@ -110,8 +110,8 @@ ui_validate_reactive_teal_data <- function(id) { id = ns("validate_messages"), class = "teal_validated", ui_validate_error(ns("silent_error")), - ui_check_class_teal_data(ns("class_teal_data")), - ui_check_module_datanames(ns("shiny_warnings")) + module_validate_teal_data$ui(ns("class_teal_data")), + module_validate_datanames$ui(ns("shiny_warnings")) ), div( class = "teal_validated", @@ -133,8 +133,8 @@ srv_validate_reactive_teal_data <- function(id, # nolint: object_length moduleServer(id, function(input, output, session) { # there is an empty reactive cycle on `init` and `data` has `shiny.silent.error` class srv_validate_error("silent_error", data, validate_shiny_silent_error) - srv_check_class_teal_data("class_teal_data", data) - srv_check_module_datanames("shiny_warnings", data, modules) + module_validate_teal_data$server("class_teal_data", data) + module_validate_datanames$server("shiny_warnings", data, modules) output$previous_failed <- renderUI({ if (hide_validation_error()) { shinyjs::hide("validate_messages") @@ -149,51 +149,8 @@ srv_validate_reactive_teal_data <- function(id, # nolint: object_length }) } -#' @keywords internal -ui_check_class_teal_data <- function(id) { - uiOutput(NS(id, "message")) -} - -#' @keywords internal -srv_check_class_teal_data <- function(id, data) { - checkmate::assert_string(id) - moduleServer(id, function(input, output, session) { - output$message <- renderUI({ - validate( - need( - inherits(data(), c("teal_data", "error")), - "Did not receive `teal_data` object. Cannot proceed further." - ) - ) - }) - }) -} - # See R/module_validate.R -# #' @keywords internal -# ui_check_module_datanames <- function(id) { -# ns <- NS(id) -# uiOutput(NS(id, "message")) -# } - -# #' @keywords internal -# srv_check_module_datanames <- function(id, data, modules) { -# checkmate::assert_string(id) -# moduleServer(id, function(input, output, session) { -# output$message <- renderUI({ -# if (inherits(data(), "teal_data")) { -# is_modules_ok <- check_modules_datanames_html( -# modules = modules, datanames = names(data()) -# ) -# if (!isTRUE(is_modules_ok)) { -# tags$div(is_modules_ok, class = "teal-output-warning") -# } -# } -# }) -# }) -# } - .trigger_on_success <- function(data) { out <- reactiveVal(NULL) observeEvent(data(), { diff --git a/R/module_transform_data.R b/R/module_transform_data.R index 26b49f0b47..74bf640598 100644 --- a/R/module_transform_data.R +++ b/R/module_transform_data.R @@ -112,9 +112,9 @@ srv_transform_teal_data <- function(id, data, transformators, modules = NULL, is }) srv_validate_error("silent_error", data_handled, validate_shiny_silent_error = FALSE) - srv_check_class_teal_data("class_teal_data", data_handled) + module_validate_teal_data$server("class_teal_data", data_handled) if (!is.null(modules)) { - srv_check_module_datanames("datanames_warning", data_handled, modules) + module_validate_datanames$server("datanames_warning", data_handled, modules) } # When there is no UI (`ui = NULL`) it should still show the errors @@ -136,8 +136,8 @@ srv_transform_teal_data <- function(id, data, transformators, modules = NULL, is shinyjs::enable(transform_wrapper_id) shiny::tagList( ui_validate_error(session$ns("silent_error")), - ui_check_class_teal_data(session$ns("class_teal_data")), - ui_check_module_datanames(session$ns("datanames_warning")) + module_validate_teal_data$ui(session$ns("class_teal_data")), + module_validate_datanames$ui(session$ns("datanames_warning")) ) } }) diff --git a/R/module_validate.R b/R/module_validate.R index 2efd72583c..9ee83eb2d9 100644 --- a/R/module_validate.R +++ b/R/module_validate.R @@ -1,66 +1,6 @@ -#' @keywords internal -ui_validate_error <- function(id) { - ns <- NS(id) - tagList( - module_validate_shinysilenterror$ui(ns("validate_shinysilent_error")), - module_validate_shinysilenterror$ui(ns("validate_validation_error")), - module_validate_reactive$ui(ns("validate_reactive")), - module_validate_teal_data$ui(ns("validate_teal_data")), - module_validate_error$ui(ns("validate_error")) - ) -} - -#' @keywords internal -srv_validate_error <- function(id, data, validate_shiny_silent_error) { - checkmate::assert_string(id) - checkmate::assert_flag(validate_shiny_silent_error) - moduleServer(id, function(input, output, session) { - # New - module_validate_shinysilenterror$server("validate_shinysilent_error", data) - module_validate_validation_error$server("validate_validation_error", data) - module_validate_reactive$server("validate_reactive", data) - module_validate_teal_data$server("validate_teal_Data", data) - module_validate_error$server("validate_error", data) - # # Uncomment line below and choose "validate error" - # module_validate_reactive$server("validate_reactive", data, types = c("simpleError", "teal_data")) - - # # Old - # output$message <- renderUI({ - # is_shiny_silent_error <- inherits(data(), "shiny.silent.error") && identical(data()$message, "") - # if (inherits(data(), "qenv.error")) { - # validate( - # need( - # FALSE, - # paste( - # "Error when executing the `data` module:", - # cli::ansi_strip(paste(data()$message, collapse = "\n")), - # "\nCheck your inputs or contact app developer if error persists.", - # collapse = "\n" - # ) - # ) - # ) - # } else if (inherits(data(), "error")) { - # if (is_shiny_silent_error && !validate_shiny_silent_error) { - # return(NULL) - # } - # validate( - # need( - # FALSE, - # sprintf( - # "Shiny error when executing the `data` module.\n%s\n%s", - # data()$message, - # "Check your inputs or contact app developer if error persists." - # ) - # ) - # ) - # } - # }) - }) -} -# ####################################### # # _ _ _ # (_) | | | | @@ -72,7 +12,6 @@ srv_validate_error <- function(id, data, validate_shiny_silent_error) { # # # internal -# ###################################### #' Factory to build validate modules #' @@ -245,7 +184,6 @@ module_validate_factory <- function(...) { ) } -# ########################################################################## # # _ _ # | | | | @@ -257,7 +195,6 @@ module_validate_factory <- function(...) { # |______| # # v_datanames -# ######################################################################### #' @keywords internal srv_module_check_datanames <- function(id, x, modules) { @@ -278,10 +215,7 @@ srv_module_check_datanames <- function(id, x, modules) { } module_validate_datanames <- module_validate_factory(srv_module_check_datanames) -srv_check_module_datanames <- module_validate_datanames$server -ui_check_module_datanames <- module_validate_datanames$ui -# ############################################################################# # # _ _ _ _ _ _ # | (_) | | | | | | (_) @@ -293,7 +227,6 @@ ui_check_module_datanames <- module_validate_datanames$ui # # # validate reactive -# ############################################################################ #' Validate if an argument is a reactive #' @@ -323,12 +256,24 @@ srv_module_check_reactive <- function(x, types = character(0L), null.ok = FALSE) TRUE } } else { - paste0("NEW: ", reactive_message) + paste0("NEW:: ", reactive_message) } }) }) } +# +# _ _ _ _ _ +# | (_) | | | | (_) +# __ ____ _| |_ __| | __ _| |_ _ ___ _ __ ___ _ __ _ __ ___ _ __ +# \ \ / / _` | | |/ _` |/ _` | __| |/ _ \| '_ \ / _ \ '__| '__/ _ \| '__| +# \ V / (_| | | | (_| | (_| | |_| | (_) | | | || __/ | | | | (_) | | +# \_/ \__,_|_|_|\__,_|\__,_|\__|_|\___/|_| |_| \___|_| |_| \___/|_| +# ______ +# |______| +# +# validation_error + #' @rdname module_validate_reactive #' @param id (`character`) The module id. #' @usage module_validate_reactive$server(x, types = character(0L), null.ok = FALSE) @@ -341,20 +286,6 @@ srv_module_check_reactive <- function(x, types = character(0L), null.ok = FALSE) #' @export module_validate_reactive <- module_validate_factory(srv_module_check_reactive) -# ########################################################################### -# -# _ _ _ _ _ -# | | (_) (_) | | | -# ___| |__ _ _ __ _ _ ___ _| | ___ _ __ | |_ ___ _ __ _ __ ___ _ __ -# / __| '_ \| | '_ \| | | / __| | |/ _ \ '_ \| __/ _ \ '__| '__/ _ \| '__| -# \__ \ | | | | | | | |_| \__ \ | | __/ | | | || __/ | | | | (_) | | -# |___/_| |_|_|_| |_|\__, |___/_|_|\___|_| |_|\__\___|_| |_| \___/|_| -# __/ | -# |___/ -# -# shinysilenterror -# ########################################################################## - #' Validate if an argument contains a `shiny.silent.error` validation error #' #' @param x (`reactive`) A reactive value. @@ -369,7 +300,7 @@ srv_module_check_validation_error <- function(x) { moduleServer("check_validation_error", function(input, output, session) { reactive({ if (checkmate::test_class(x(), c("shiny.silent.error", "validation")) && !identical(x()$message, "")) { - sprintf("NEW: Shiny validation error was raised: %s", x()$message) + sprintf("NEW:: Shiny validation error was raised: %s", x()$message) } else { TRUE } @@ -389,6 +320,18 @@ srv_module_check_validation_error <- function(x) { #' @export module_validate_validation_error <- module_validate_factory(srv_module_check_validation_error) +# +# _ _ _ _ _ +# | | (_) (_) | | | +# ___| |__ _ _ __ _ _ ___ _| | ___ _ __ | |_ ___ _ __ _ __ ___ _ __ +# / __| '_ \| | '_ \| | | / __| | |/ _ \ '_ \| __/ _ \ '__| '__/ _ \| '__| +# \__ \ | | | | | | | |_| \__ \ | | __/ | | | || __/ | | | | (_) | | +# |___/_| |_|_|_| |_|\__, |___/_|_|\___|_| |_|\__\___|_| |_| \___/|_| +# __/ | +# |___/ +# +# shinysilenterror + #' Validate if an argument contains a `shiny.silent.error` #' #' @param x (`reactive`) A reactive value. @@ -402,8 +345,8 @@ module_validate_validation_error <- module_validate_factory(srv_module_check_val srv_module_check_shinysilenterror <- function(x) { moduleServer("check_shinysilenterror", function(input, output, session) { reactive({ - if (inherits(x(), "shiny.silent.error") && identical(x()$message, "")) { - "NEW: Shiny silent error was raised" + if (validate_shiny_silent_error && inherits(x(), "shiny.silent.error") && identical(x()$message, "")) { + "NEW:: Shiny silent error was raised" } else { TRUE } @@ -423,7 +366,6 @@ srv_module_check_shinysilenterror <- function(x) { #' @export module_validate_shinysilenterror <- module_validate_factory(srv_module_check_shinysilenterror) -# ############################################################################### # # _ _ _ _ _ _ _ _ # | (_) | | | | | | | | | | | | @@ -435,19 +377,20 @@ module_validate_shinysilenterror <- module_validate_factory(srv_module_check_shi # |______| # # validate teal_data -# ############################################################################## srv_module_check_teal_data <- function(x) { moduleServer("check_teal_data", function(input, output, session) { reactive({ - if (inherits(x(), "qenv.error")) { + if (inherits(x(), "qenv.error")) { # TODO: remove qenv.error c( - "NEW: Error when executing the `data` module:", + "NEW:: Error when executing the `data` module:", cli::ansi_strip(x()$message), "", "Check your inputs or contact app developer if error persists." ) + } else if (!inherits(x(), c("teal_data", "error"))) { + "NEW:: Did not receive `teal_data` object. Cannot proceed further." } else { TRUE } @@ -457,7 +400,6 @@ srv_module_check_teal_data <- function(x) { module_validate_teal_data <- module_validate_factory(srv_module_check_teal_data) -# ################################################################## # # _ _ _ _ # | (_) | | | | @@ -468,15 +410,15 @@ module_validate_teal_data <- module_validate_factory(srv_module_check_teal_data) # # # -# validate error -# ################################################################# +# validate condition -srv_module_check_error <- function(x) { +srv_module_check_condition <- function(x, validate_shiny_silent_error = TRUE) { moduleServer("check_error", function(input, output, session) { reactive({ - if (inherits(x(), "error") && !inherits(x(), c("qenv.error", "shiny.silent.error"))) { - c("NEW: Error detected", x()$message) + # TODO: remove qenv.error + if (validate_shiny_silent_error && inherits(x(), "error") && !inherits(x(), c("qenv.error", "shiny.silent.error"))) { + c("NEW:: Error detected", x()$message) } else { TRUE } @@ -484,9 +426,8 @@ srv_module_check_error <- function(x) { }) } -module_validate_error <- module_validate_factory(srv_module_check_error) +module_validate_condition <- module_validate_factory(srv_module_check_condition) -# ########################################## # # ___ # |__ \ @@ -498,7 +439,6 @@ module_validate_error <- module_validate_factory(srv_module_check_error) # # # todo: remove? -# ######################################### .substitute_template_curly <- function(template_str, module_server_body, check_calls) { call_inject <- if (length(check_calls) > 1) { @@ -586,7 +526,6 @@ module_validate_factory_single <- function(module_id, check_fun) { ) } -######################################################################### # # _ __ ___ # | | / _| |__ \ @@ -598,4 +537,70 @@ module_validate_factory_single <- function(module_id, check_fun) { # # # end of remove? -# ######################################################################## + + +module_validate_error <- module_validate_factory( + srv_module_check_shinysilenterror, + srv_module_check_validation_error, + srv_module_check_reactive, + srv_module_check_condition +) + +#' @keywords internal +ui_validate_error <- function(id) { + ns <- NS(id) + tagList( + module_validate_shinysilenterror$ui(ns("validate_shinysilent_error")), + module_validate_shinysilenterror$ui(ns("validate_validation_error")), + module_validate_reactive$ui(ns("validate_reactive")), + # module_validate_teal_data$ui(ns("validate_teal_data")), + module_validate_condition$ui(ns("validate_condition")) + ) +} + +#' @keywords internal +srv_validate_error <- function(id, data, validate_shiny_silent_error) { + checkmate::assert_string(id) + checkmate::assert_flag(validate_shiny_silent_error) + moduleServer(id, function(input, output, session) { + module_validate_shinysilenterror$server("validate_shinysilent_error", data) + module_validate_validation_error$server("validate_validation_error", data) + module_validate_reactive$server("validate_reactive", data) + module_validate_condition$server("validate_condition", data) + + # # Uncomment line below and choose "validate error" + # module_validate_reactive$server("validate_reactive", data, types = c("simpleError", "teal_data")) + + # # Old + # output$message <- renderUI({ + # is_shiny_silent_error <- inherits(data(), "shiny.silent.error") && identical(data()$message, "") + # if (inherits(data(), "qenv.error")) { + # validate( + # need( + # FALSE, + # paste( + # "Error when executing the `data` module:", + # cli::ansi_strip(paste(data()$message, collapse = "\n")), + # "\nCheck your inputs or contact app developer if error persists.", + # collapse = "\n" + # ) + # ) + # ) + # } else if (inherits(data(), "error")) { + # if (is_shiny_silent_error && !validate_shiny_silent_error) { + # return(NULL) + # } + # validate( + # need( + # FALSE, + # sprintf( + # "Shiny error when executing the `data` module.\n%s\n%s", + # data()$message, + # "Check your inputs or contact app developer if error persists." + # ) + # ) + # ) + # } + # }) + }) +} From 4ec7ef6960d91782dce5671c330fda719a0c911a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Mon, 31 Mar 2025 15:46:14 +0100 Subject: [PATCH 06/50] chore: rename ongoing --- R/module_teal.R | 4 +-- R/module_teal_data.R | 4 +-- R/module_transform_data.R | 4 +-- R/module_validate.R | 63 ++------------------------------------- 4 files changed, 8 insertions(+), 67 deletions(-) diff --git a/R/module_teal.R b/R/module_teal.R index 4aa691cecd..1724f7994c 100644 --- a/R/module_teal.R +++ b/R/module_teal.R @@ -140,11 +140,11 @@ srv_teal <- function(id, data, modules, filter = teal_slices()) { id = session$ns("validate_messages"), class = "teal_validated", module_validate_teal_data$ui(session$ns("class_teal_data")), - ui_validate_error(session$ns("silent_error")), + module_validate_error$ui(session$ns("silent_error")), module_validate_datanames$ui(session$ns("datanames_warning")) ) module_validate_teal_data$server("class_teal_data", data_handled) - srv_validate_error("silent_error", data_handled, validate_shiny_silent_error = FALSE) + module_validate_error$server("silent_error", x = data_handled, validate_shiny_silent_error = FALSE) module_validate_datanames$server("datanames_warning", data_handled, modules) data_validated <- .trigger_on_success(data_handled) diff --git a/R/module_teal_data.R b/R/module_teal_data.R index 7cd0c4f347..6e519615dc 100644 --- a/R/module_teal_data.R +++ b/R/module_teal_data.R @@ -109,7 +109,7 @@ ui_validate_reactive_teal_data <- function(id) { div( id = ns("validate_messages"), class = "teal_validated", - ui_validate_error(ns("silent_error")), + module_validate_error$ui(ns("silent_error")), module_validate_teal_data$ui(ns("class_teal_data")), module_validate_datanames$ui(ns("shiny_warnings")) ), @@ -132,7 +132,7 @@ srv_validate_reactive_teal_data <- function(id, # nolint: object_length moduleServer(id, function(input, output, session) { # there is an empty reactive cycle on `init` and `data` has `shiny.silent.error` class - srv_validate_error("silent_error", data, validate_shiny_silent_error) + module_validate_error$server("silent_error", x = data, validate_shiny_silent_error = validate_shiny_silent_error) module_validate_teal_data$server("class_teal_data", data) module_validate_datanames$server("shiny_warnings", data, modules) output$previous_failed <- renderUI({ diff --git a/R/module_transform_data.R b/R/module_transform_data.R index 74bf640598..105e2981f5 100644 --- a/R/module_transform_data.R +++ b/R/module_transform_data.R @@ -111,7 +111,7 @@ srv_transform_teal_data <- function(id, data, transformators, modules = NULL, is any(idx_failures < idx_this) }) - srv_validate_error("silent_error", data_handled, validate_shiny_silent_error = FALSE) + module_validate_error$server("silent_error", x = data_handled, validate_shiny_silent_error = FALSE) module_validate_teal_data$server("class_teal_data", data_handled) if (!is.null(modules)) { module_validate_datanames$server("datanames_warning", data_handled, modules) @@ -135,7 +135,7 @@ srv_transform_teal_data <- function(id, data, transformators, modules = NULL, is } else { shinyjs::enable(transform_wrapper_id) shiny::tagList( - ui_validate_error(session$ns("silent_error")), + module_validate_error$ui(session$ns("silent_error")), module_validate_teal_data$ui(session$ns("class_teal_data")), module_validate_datanames$ui(session$ns("datanames_warning")) ) diff --git a/R/module_validate.R b/R/module_validate.R index 9ee83eb2d9..4ea0741128 100644 --- a/R/module_validate.R +++ b/R/module_validate.R @@ -143,7 +143,7 @@ module_validate_factory <- function(...) { new_body_list <- .substitute_template(template_str, module_server_body, check_calls) server_body <- substitute({ - assert_reactive(x) + checkmate::assert_string(id) # Mandatory id parameter moduleServer(id, function(input, output, session) server_body) }, list(server_body = new_body_list)) @@ -342,7 +342,7 @@ module_validate_validation_error <- module_validate_factory(srv_module_check_val #' @returns A module that validates the reactive value. #' #' @export -srv_module_check_shinysilenterror <- function(x) { +srv_module_check_shinysilenterror <- function(x, validate_shiny_silent_error = TRUE) { moduleServer("check_shinysilenterror", function(input, output, session) { reactive({ if (validate_shiny_silent_error && inherits(x(), "shiny.silent.error") && identical(x()$message, "")) { @@ -545,62 +545,3 @@ module_validate_error <- module_validate_factory( srv_module_check_reactive, srv_module_check_condition ) - -#' @keywords internal -ui_validate_error <- function(id) { - ns <- NS(id) - tagList( - module_validate_shinysilenterror$ui(ns("validate_shinysilent_error")), - module_validate_shinysilenterror$ui(ns("validate_validation_error")), - module_validate_reactive$ui(ns("validate_reactive")), - # module_validate_teal_data$ui(ns("validate_teal_data")), - module_validate_condition$ui(ns("validate_condition")) - ) -} - -#' @keywords internal -srv_validate_error <- function(id, data, validate_shiny_silent_error) { - checkmate::assert_string(id) - checkmate::assert_flag(validate_shiny_silent_error) - moduleServer(id, function(input, output, session) { - module_validate_shinysilenterror$server("validate_shinysilent_error", data) - module_validate_validation_error$server("validate_validation_error", data) - module_validate_reactive$server("validate_reactive", data) - module_validate_condition$server("validate_condition", data) - - # # Uncomment line below and choose "validate error" - # module_validate_reactive$server("validate_reactive", data, types = c("simpleError", "teal_data")) - - # # Old - # output$message <- renderUI({ - # is_shiny_silent_error <- inherits(data(), "shiny.silent.error") && identical(data()$message, "") - # if (inherits(data(), "qenv.error")) { - # validate( - # need( - # FALSE, - # paste( - # "Error when executing the `data` module:", - # cli::ansi_strip(paste(data()$message, collapse = "\n")), - # "\nCheck your inputs or contact app developer if error persists.", - # collapse = "\n" - # ) - # ) - # ) - # } else if (inherits(data(), "error")) { - # if (is_shiny_silent_error && !validate_shiny_silent_error) { - # return(NULL) - # } - # validate( - # need( - # FALSE, - # sprintf( - # "Shiny error when executing the `data` module.\n%s\n%s", - # data()$message, - # "Check your inputs or contact app developer if error persists." - # ) - # ) - # ) - # } - # }) - }) -} From 26e9624cc9b439d53d69279eaf97a713166f1451 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Mon, 31 Mar 2025 15:48:01 +0100 Subject: [PATCH 07/50] chore: remove null coalesce operator that is no longer used --- R/zzz.R | 2 -- 1 file changed, 2 deletions(-) diff --git a/R/zzz.R b/R/zzz.R index 003218b72b..62c8029561 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -25,8 +25,6 @@ # we avoid `desc` dependency here to get the version read.dcf(system.file("DESCRIPTION", package = "teal"))[, "Version"] ) - - if (version$minor < 4) `%||%` <<- rlang::`%||%` } # This one is here because setdiff_teal_slice should not be exported from teal.slice. From 4d25b08d38707992084db0b2bcbf30aae2aef6e5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Mon, 31 Mar 2025 15:51:08 +0100 Subject: [PATCH 08/50] chore: cleanup --- NAMESPACE | 2 ++ R/module_validate.R | 7 ++++--- man/module_validate_shinysilenterror.Rd | 23 +++++++++++++++++++++-- 3 files changed, 27 insertions(+), 5 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index e5321f1acb..70703693c2 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -31,6 +31,7 @@ export(module) export(module_validate_factory) export(module_validate_reactive) export(module_validate_shinysilenterror) +export(module_validate_validation_error) export(modules) export(new_tdata) export(report_card_template) @@ -38,6 +39,7 @@ export(reporter_previewer_module) export(show_rcode_modal) export(srv_module_check_reactive) export(srv_module_check_shinysilenterror) +export(srv_module_check_validation_error) export(srv_session_info) export(srv_teal) export(srv_teal_with_splash) diff --git a/R/module_validate.R b/R/module_validate.R index 4ea0741128..f6a0ba2782 100644 --- a/R/module_validate.R +++ b/R/module_validate.R @@ -170,7 +170,7 @@ module_validate_factory <- function(...) { .substitute_template <- function(template_str, module_server_body, check_calls) { # Create server body with expressions for multiple checks # note: using substitute directly will add curly braces around body - # todo: discuss this approach vs. having curly braces + # TODO: discuss this approach vs. having curly braces body_list <- as.list(module_server_body)[-1] ix <- which(body_list == as.name(template_str)) @@ -412,12 +412,13 @@ module_validate_teal_data <- module_validate_factory(srv_module_check_teal_data) # # validate condition -srv_module_check_condition <- function(x, validate_shiny_silent_error = TRUE) { +srv_module_check_condition <- function(x) { moduleServer("check_error", function(input, output, session) { reactive({ # TODO: remove qenv.error - if (validate_shiny_silent_error && inherits(x(), "error") && !inherits(x(), c("qenv.error", "shiny.silent.error"))) { + # shiny.silent.errors are handled in a different module + if (inherits(x(), "error") && !inherits(x(), c("qenv.error", "shiny.silent.error"))) { c("NEW:: Error detected", x()$message) } else { TRUE diff --git a/man/module_validate_shinysilenterror.Rd b/man/module_validate_shinysilenterror.Rd index 69ddb4d1ad..4d0bb72775 100644 --- a/man/module_validate_shinysilenterror.Rd +++ b/man/module_validate_shinysilenterror.Rd @@ -3,13 +3,22 @@ \docType{data} \name{module_validate_shinysilenterror} \alias{module_validate_shinysilenterror} +\alias{srv_module_check_validation_error} +\alias{module_validate_validation_error} \alias{srv_module_check_shinysilenterror} -\title{Validate if an argument contains a \code{shiny.silent.error}} +\title{Validate if an argument contains a \code{shiny.silent.error} validation error} \format{ +An object of class \code{list} of length 2. + An object of class \code{list} of length 2. } \usage{ -srv_module_check_shinysilenterror(x) +srv_module_check_validation_error(x) + +module_validate_shinysilenterror$ui(id) +module_validate_shinysilenterror$server(x) + +srv_module_check_shinysilenterror(x, validate_shiny_silent_error = TRUE) module_validate_shinysilenterror$ui(id) module_validate_shinysilenterror$server(x) @@ -20,18 +29,28 @@ module_validate_shinysilenterror$server(x) \item{id}{(\code{character}) The module id.} } \value{ +A module that validates the reactive value. + A module that validates the reactive value. } \description{ +Validate if an argument contains a \code{shiny.silent.error} validation error + Validate if an argument contains a \code{shiny.silent.error} } \examples{ module_validate_shinysilenterror$ui("validate_reactive") +# Show the generated server function +print(module_validate_shinysilenterror$server) +module_validate_shinysilenterror$ui("validate_reactive") + # Show the generated server function print(module_validate_shinysilenterror$server) } \seealso{ +\code{\link[=module_validate_factory]{module_validate_factory()}} + \code{\link[=module_validate_factory]{module_validate_factory()}} } \keyword{datasets} From ef5859f84bdda307f705a8f1b9f5db61f2273640 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Mon, 31 Mar 2025 16:37:41 +0100 Subject: [PATCH 09/50] chore: adds comments and remove single factory function --- R/module_validate.R | 70 ++++++++------------------------------------- 1 file changed, 12 insertions(+), 58 deletions(-) diff --git a/R/module_validate.R b/R/module_validate.R index f6a0ba2782..28f735ffa3 100644 --- a/R/module_validate.R +++ b/R/module_validate.R @@ -60,8 +60,10 @@ module_validate_factory <- function(...) { dots <- rlang::list2(...) checkmate::check_list(dots, min.len = 1) + # Capture function names in arguments fun_names <- match.call(expand.dots = FALSE)[["..."]] + # Generate calls to each of the check functions check_calls <- lapply( seq_len(length(dots)), function(fun_ix) { @@ -80,8 +82,11 @@ module_validate_factory <- function(...) { } ) + # Empty server template new_server_fun = function(id) TRUE + # Union of formals for all check functions (order of arguments is kept) + # Conflicting argument name/default will throw an exception. top_level_formals <- Reduce( function(u, v) { new_formals <- formals(v) @@ -140,19 +145,21 @@ module_validate_factory <- function(...) { x }, list(check_calls == as.name(template_str))) + # Replace template string with check function calls new_body_list <- .substitute_template(template_str, module_server_body, check_calls) + # Generate top-level moduleServer function with default assertions server_body <- substitute({ checkmate::assert_string(id) # Mandatory id parameter moduleServer(id, function(input, output, session) server_body) }, list(server_body = new_body_list)) - formals(new_server_fun) <- top_level_formals - body(new_server_fun) <- server_body + formals(new_server_fun) <- top_level_formals # update function formals + body(new_server_fun) <- server_body # set the new generated body + # ui function contains a simple "error" element new_ui_fun <- function(id) uiOutput(NS(id, "errors")) - # todo: check if body need list(ui = new_ui_fun, server = new_server_fun) } @@ -345,6 +352,8 @@ module_validate_validation_error <- module_validate_factory(srv_module_check_val srv_module_check_shinysilenterror <- function(x, validate_shiny_silent_error = TRUE) { moduleServer("check_shinysilenterror", function(input, output, session) { reactive({ + print(glue::glue("val: {validate_shiny_silent_error}")) + print(glue::glue("classes:", paste(class(x()), collapse = ", "))) if (validate_shiny_silent_error && inherits(x(), "shiny.silent.error") && identical(x()$message, "")) { "NEW:: Shiny silent error was raised" } else { @@ -472,61 +481,6 @@ module_validate_condition <- module_validate_factory(srv_module_check_condition) }, list(check_calls = call_inject)) } -module_validate_factory_single <- function(module_id, check_fun) { - fun_name <- if (is.character(check_fun)) check_fun else deparse(substitute(check_fun)) - fun_formals <- formals(check_fun) - - server_body <- substitute( - { - moduleServer(module_id, function(input, output, session) { - collection <- list() - # todo: start with a req() of first argument - collection <- append(collection, check_call) - - validate_r <- reactive({ - message_collection <- Reduce( - function(u, v) if (isTRUE(v())) u else c(u, v()), - x = collection, - init = c() - ) - - validate(need(length(message_collection) == 0, message_collection)) - TRUE - }) - - output$errors <- renderUI({ - validate_r() - NULL - }) - - x - }) - }, - list( - # Generates call with exact formals of check function - check_call = rlang::call2(fun_name, !!!lapply(names(fun_formals), as.name)), - module_id = module_id - ) - ) - - new_server_fun = function() TRUE - formals(new_server_fun) <- formals(check_fun) - body(new_server_fun) <- server_body - - new_ui_fun <- function(id) TRUE - body(new_ui_fun) <- substitute( - { - uiOutput(NS(NS(id, module_id), "errors")) - }, - list(module_id = module_id) - ) - - list( - ui = new_ui_fun, - server = new_server_fun - ) -} - # # _ __ ___ # | | / _| |__ \ From f8d9ea49fc211e7d355a0d21502a68300118a8ca Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Mon, 31 Mar 2025 16:38:37 +0100 Subject: [PATCH 10/50] chore: remove print statements --- R/module_validate.R | 2 -- 1 file changed, 2 deletions(-) diff --git a/R/module_validate.R b/R/module_validate.R index 28f735ffa3..3f4f22f739 100644 --- a/R/module_validate.R +++ b/R/module_validate.R @@ -352,8 +352,6 @@ module_validate_validation_error <- module_validate_factory(srv_module_check_val srv_module_check_shinysilenterror <- function(x, validate_shiny_silent_error = TRUE) { moduleServer("check_shinysilenterror", function(input, output, session) { reactive({ - print(glue::glue("val: {validate_shiny_silent_error}")) - print(glue::glue("classes:", paste(class(x()), collapse = ", "))) if (validate_shiny_silent_error && inherits(x(), "shiny.silent.error") && identical(x()$message, "")) { "NEW:: Shiny silent error was raised" } else { From b9ddaeeeaf2026aa42b9affda6c555b86f596ce5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Mon, 31 Mar 2025 18:01:53 +0100 Subject: [PATCH 11/50] visual: cleanup and better messages --- R/module_validate.R | 40 +++++++++++++++++++++++++++++----------- R/utils.R | 2 +- inst/css/validation.css | 29 +++++++++++++++++++++-------- 3 files changed, 51 insertions(+), 20 deletions(-) diff --git a/R/module_validate.R b/R/module_validate.R index 3f4f22f739..1d039b426c 100644 --- a/R/module_validate.R +++ b/R/module_validate.R @@ -131,11 +131,15 @@ module_validate_factory <- function(...) { validate_r(), function(.x) { html_class <- if (isTRUE(attr(.x[1], "is_warning")) || isTRUE(attr(.x, "is_warning"))) { - "teal-output-warning" + "teal-output-warning teal-output-condition" } else { - "shiny-output-error" + "shiny-output-error teal-output-condition" } - tags$div(class = html_class, tags$div(lapply(.x, tags$p))) + if (!checkmate::test_multi_class(.x, c("shiny.tag", "shiny.tag.list"))) { + html_class <- c(html_class, "prewrap-ws") + .x <- lapply(.x, tags$p) + } + tags$div(class = html_class, tags$div(.x)) } ) ) @@ -390,14 +394,25 @@ srv_module_check_teal_data <- function(x) { reactive({ if (inherits(x(), "qenv.error")) { # TODO: remove qenv.error - c( - "NEW:: Error when executing the `data` module:", - cli::ansi_strip(x()$message), - "", - "Check your inputs or contact app developer if error persists." - ) + details <- attr(x(), "details", exact = TRUE) + if (is.null(details)) { + c( + "NEW:: Error when executing the `data` module:", + cli::ansi_strip(x()$message), + "", + "Check your inputs or contact app developer if error persists." + ) + } else { + tagList( + tags$span("NEW:: Error when executing the `data` module:"), + tags$span(tags$strong(cli::ansi_strip(details$condition_message))), + tags$code(class = "code-error", details$current_code) + ) + } } else if (!inherits(x(), c("teal_data", "error"))) { - "NEW:: Did not receive `teal_data` object. Cannot proceed further." + tags$span( + "NEW:: Did not receive", tags$code("teal_data"), "object. Cannot proceed further." + ) } else { TRUE } @@ -426,7 +441,10 @@ srv_module_check_condition <- function(x) { # TODO: remove qenv.error # shiny.silent.errors are handled in a different module if (inherits(x(), "error") && !inherits(x(), c("qenv.error", "shiny.silent.error"))) { - c("NEW:: Error detected", x()$message) + tagList( + tags$span("NEW:: Error detected"), + tags$code(trimws(x()$message)) + ) } else { TRUE } diff --git a/R/utils.R b/R/utils.R index 6dd53dc119..c218460299 100644 --- a/R/utils.R +++ b/R/utils.R @@ -175,7 +175,7 @@ check_modules_datanames_html <- function(modules, datanames) { lapply( check_datanames, function(mod) { - tagList( + tags$p( tags$span( tags$span(pluralize(mod$missing_datanames, "Dataset")), to_html_code_list(mod$missing_datanames), diff --git a/inst/css/validation.css b/inst/css/validation.css index 82e22b02bc..df947a5e0e 100644 --- a/inst/css/validation.css +++ b/inst/css/validation.css @@ -13,6 +13,15 @@ color: #888; } +.teal-output-condition { + white-space: normal; + line-height: 2em; +} + +.teal-output-condition .prewrap-ws { + white-space: pre-wrap; +} + .teal_validated .shiny-output-error, .teal_validated .teal-output-warning { display: flex; @@ -31,28 +40,28 @@ margin-bottom: 0; } -.teal_validated .teal-output-warning::before { - content: "\26A0\FE0F"; +.teal_validated .teal-output-warning::before, +.teal_validated .shiny-output-error::before, +.teal_primary_col .shiny-output-error::before, +.teal_primary_col .teal-output-warning::before { padding-left: 0.3em; padding-right: 0.3em; } +.teal_validated .teal-output-warning::before { + content: "\26A0\FE0F"; +} + .teal_validated .shiny-output-error::before { content: "\1F6A8"; - padding-left: 0.3em; - padding-right: 0.3em; } .teal_primary_col .shiny-output-error::before { content: "\1F6A8"; - padding-left: 0.3em; - padding-right: 0.3em; } .teal_primary_col .teal-output-warning::before { content: "\26A0\FE0F"; - padding-left: 0.3em; - padding-right: 0.3em; } .teal_primary_col .teal_validated:has(.shiny-output-error), @@ -68,3 +77,7 @@ border: 1px solid red; padding: 1em; } + +.code-error { + margin-left: 1em; +} From abe4a18534e26f7c91595b3c54a7099e0748037f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 1 Apr 2025 08:38:16 +0100 Subject: [PATCH 12/50] style: improve look of messages using blockquote and em --- R/module_validate.R | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/R/module_validate.R b/R/module_validate.R index 1d039b426c..04fb2a9faa 100644 --- a/R/module_validate.R +++ b/R/module_validate.R @@ -311,7 +311,10 @@ srv_module_check_validation_error <- function(x) { moduleServer("check_validation_error", function(input, output, session) { reactive({ if (checkmate::test_class(x(), c("shiny.silent.error", "validation")) && !identical(x()$message, "")) { - sprintf("NEW:: Shiny validation error was raised: %s", x()$message) + tagList( + tags$span("NEW:: Shiny validation error was raised:"), + tags$blockquote(tags$em(x()$message)) + ) } else { TRUE } @@ -404,8 +407,9 @@ srv_module_check_teal_data <- function(x) { ) } else { tagList( - tags$span("NEW:: Error when executing the `data` module:"), - tags$span(tags$strong(cli::ansi_strip(details$condition_message))), + tags$span("NEW:: Error when executing the", tags$code("data"), "module:"), + tags$blockquote(tags$em(cli::ansi_strip(details$condition_message))), + tags$span("from code:"), tags$code(class = "code-error", details$current_code) ) } @@ -442,8 +446,8 @@ srv_module_check_condition <- function(x) { # shiny.silent.errors are handled in a different module if (inherits(x(), "error") && !inherits(x(), c("qenv.error", "shiny.silent.error"))) { tagList( - tags$span("NEW:: Error detected"), - tags$code(trimws(x()$message)) + tags$span("NEW:: Error detected:"), + tags$blockquote(tags$em(trimws(x()$message))) ) } else { TRUE From 7ebaa4eb96509f21917a3fdecd342553da5b828b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 1 Apr 2025 09:52:04 +0100 Subject: [PATCH 13/50] chore: remove extra comments and functions --- R/module_validate.R | 144 +--------------------------------------- inst/css/validation.css | 6 ++ 2 files changed, 7 insertions(+), 143 deletions(-) diff --git a/R/module_validate.R b/R/module_validate.R index 04fb2a9faa..38911a958c 100644 --- a/R/module_validate.R +++ b/R/module_validate.R @@ -1,18 +1,3 @@ - - - -# -# _ _ _ -# (_) | | | | -# _ _ __ | |_ ___ _ __ _ __ __ _| | -# | | '_ \| __/ _ \ '__| '_ \ / _` | | -# | | | | | || __/ | | | | | (_| | | -# |_|_| |_|\__\___|_| |_| |_|\__,_|_| -# -# -# -# internal - #' Factory to build validate modules #' #' This function is used to create a module that validates the reactive data @@ -64,6 +49,7 @@ module_validate_factory <- function(...) { fun_names <- match.call(expand.dots = FALSE)[["..."]] # Generate calls to each of the check functions + # TODO: extract from here check_calls <- lapply( seq_len(length(dots)), function(fun_ix) { @@ -195,18 +181,6 @@ module_validate_factory <- function(...) { ) } -# -# _ _ -# | | | | -# __ __ __| | __ _| |_ __ _ _ __ __ _ _ __ ___ ___ ___ -# \ \ / / / _` |/ _` | __/ _` | '_ \ / _` | '_ ` _ \ / _ \/ __| -# \ V / | (_| | (_| | || (_| | | | | (_| | | | | | | __/\__ \ -# \_/ \__,_|\__,_|\__\__,_|_| |_|\__,_|_| |_| |_|\___||___/ -# ______ -# |______| -# -# v_datanames - #' @keywords internal srv_module_check_datanames <- function(id, x, modules) { checkmate::assert_string(id) @@ -227,18 +201,6 @@ srv_module_check_datanames <- function(id, x, modules) { module_validate_datanames <- module_validate_factory(srv_module_check_datanames) -# -# _ _ _ _ _ _ -# | (_) | | | | | | (_) -# __ ____ _| |_ __| | __ _| |_ ___ _ __ ___ __ _ ___| |_ ___ _____ -# \ \ / / _` | | |/ _` |/ _` | __/ _ \ | '__/ _ \/ _` |/ __| __| \ \ / / _ \ -# \ V / (_| | | | (_| | (_| | || __/ | | | __/ (_| | (__| |_| |\ V / __/ -# \_/ \__,_|_|_|\__,_|\__,_|\__\___| |_| \___|\__,_|\___|\__|_| \_/ \___| -# -# -# -# validate reactive - #' Validate if an argument is a reactive #' #' @param x (`reactive`) A reactive value. @@ -273,18 +235,6 @@ srv_module_check_reactive <- function(x, types = character(0L), null.ok = FALSE) }) } -# -# _ _ _ _ _ -# | (_) | | | | (_) -# __ ____ _| |_ __| | __ _| |_ _ ___ _ __ ___ _ __ _ __ ___ _ __ -# \ \ / / _` | | |/ _` |/ _` | __| |/ _ \| '_ \ / _ \ '__| '__/ _ \| '__| -# \ V / (_| | | | (_| | (_| | |_| | (_) | | | || __/ | | | | (_) | | -# \_/ \__,_|_|_|\__,_|\__,_|\__|_|\___/|_| |_| \___|_| |_| \___/|_| -# ______ -# |______| -# -# validation_error - #' @rdname module_validate_reactive #' @param id (`character`) The module id. #' @usage module_validate_reactive$server(x, types = character(0L), null.ok = FALSE) @@ -334,18 +284,6 @@ srv_module_check_validation_error <- function(x) { #' @export module_validate_validation_error <- module_validate_factory(srv_module_check_validation_error) -# -# _ _ _ _ _ -# | | (_) (_) | | | -# ___| |__ _ _ __ _ _ ___ _| | ___ _ __ | |_ ___ _ __ _ __ ___ _ __ -# / __| '_ \| | '_ \| | | / __| | |/ _ \ '_ \| __/ _ \ '__| '__/ _ \| '__| -# \__ \ | | | | | | | |_| \__ \ | | __/ | | | || __/ | | | | (_) | | -# |___/_| |_|_|_| |_|\__, |___/_|_|\___|_| |_|\__\___|_| |_| \___/|_| -# __/ | -# |___/ -# -# shinysilenterror - #' Validate if an argument contains a `shiny.silent.error` #' #' @param x (`reactive`) A reactive value. @@ -380,18 +318,6 @@ srv_module_check_shinysilenterror <- function(x, validate_shiny_silent_error = T #' @export module_validate_shinysilenterror <- module_validate_factory(srv_module_check_shinysilenterror) -# -# _ _ _ _ _ _ _ _ -# | (_) | | | | | | | | | | | | -# __ ____ _| |_ __| | __ _| |_ ___ | |_ ___ __ _| | __| | __ _| |_ __ _ -# \ \ / / _` | | |/ _` |/ _` | __/ _ \ | __/ _ \/ _` | | / _` |/ _` | __/ _` | -# \ V / (_| | | | (_| | (_| | || __/ | || __/ (_| | || (_| | (_| | || (_| | -# \_/ \__,_|_|_|\__,_|\__,_|\__\___| \__\___|\__,_|_| \__,_|\__,_|\__\__,_| -# ______ -# |______| -# -# validate teal_data - srv_module_check_teal_data <- function(x) { moduleServer("check_teal_data", function(input, output, session) { @@ -426,18 +352,6 @@ srv_module_check_teal_data <- function(x) { module_validate_teal_data <- module_validate_factory(srv_module_check_teal_data) -# -# _ _ _ _ -# | (_) | | | | -# __ ____ _| |_ __| | __ _| |_ ___ ___ _ __ _ __ ___ _ __ -# \ \ / / _` | | |/ _` |/ _` | __/ _ \ / _ \ '__| '__/ _ \| '__| -# \ V / (_| | | | (_| | (_| | || __/ | __/ | | | | (_) | | -# \_/ \__,_|_|_|\__,_|\__,_|\__\___| \___|_| |_| \___/|_| -# -# -# -# validate condition - srv_module_check_condition <- function(x) { moduleServer("check_error", function(input, output, session) { @@ -458,62 +372,6 @@ srv_module_check_condition <- function(x) { module_validate_condition <- module_validate_factory(srv_module_check_condition) -# -# ___ -# |__ \ -# _ __ ___ _ __ ___ _____ _____ ) | -# | '__/ _ \ '_ ` _ \ / _ \ \ / / _ \/ / -# | | | __/ | | | | | (_) \ V / __/_| -# |_| \___|_| |_| |_|\___/ \_/ \___(_) -# -# -# -# todo: remove? - -.substitute_template_curly <- function(template_str, module_server_body, check_calls) { - call_inject <- if (length(check_calls) > 1) { - as.call(c(quote(`{`), check_calls)) - } else { - as.call(check_calls[[1]]) - } - - vv <- substitute({ - collection <- list() - check_calls - - validate_r <- reactive({ - message_collection <- Reduce( - function(u, v) if (isTRUE(v())) u else c(u, v()), - x = collection, - init = c() - ) - - validate(need(length(message_collection) == 0, message_collection)) - TRUE - }) - - output$errors <- renderUI({ - validate_r() - NULL - }) - - x - }, list(check_calls = call_inject)) -} - -# -# _ __ ___ -# | | / _| |__ \ -# ___ _ __ __| | ___ | |_ _ __ ___ _ __ ___ _____ _____ ) | -# / _ \ '_ \ / _` | / _ \| _| | '__/ _ \ '_ ` _ \ / _ \ \ / / _ \/ / -# | __/ | | | (_| | | (_) | | | | | __/ | | | | | (_) \ V / __/_| -# \___|_| |_|\__,_| \___/|_| |_| \___|_| |_| |_|\___/ \_/ \___(_) -# -# -# -# end of remove? - - module_validate_error <- module_validate_factory( srv_module_check_shinysilenterror, srv_module_check_validation_error, diff --git a/inst/css/validation.css b/inst/css/validation.css index df947a5e0e..9e14e5eed2 100644 --- a/inst/css/validation.css +++ b/inst/css/validation.css @@ -81,3 +81,9 @@ .code-error { margin-left: 1em; } + +.teal-sidebar .teal-output-condition blockcode, +.teal-sidebar .teal-output-condition .code-error { + padding-left: 0; + margin-left: 0; +} From ccd78f6ae5c56fcf5bb5b0500b5865c94e0d7f9d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Thu, 3 Apr 2025 23:23:14 +0100 Subject: [PATCH 14/50] feat: cleanup --- R/module_transform_data.R | 81 ++++++++++++++++++-------------- R/teal_transform_module.R | 1 - inst/css/validation.css | 98 ++++++++++++++++----------------------- 3 files changed, 87 insertions(+), 93 deletions(-) diff --git a/R/module_transform_data.R b/R/module_transform_data.R index 105e2981f5..ac16188f5a 100644 --- a/R/module_transform_data.R +++ b/R/module_transform_data.R @@ -31,35 +31,51 @@ ui_transform_teal_data <- function(id, transformators, class = "well") { child_id <- NS(id, name) ns <- NS(child_id) data_mod <- transformators[[name]] - transform_wrapper_id <- ns(sprintf("wrapper_%s", name)) - - display_fun <- if (is.null(data_mod$ui)) shinyjs::hidden else function(x) x - - display_fun( - bslib::accordion( - bslib::accordion_panel( - attr(data_mod, "label"), - icon = bsicons::bs_icon("palette-fill"), - tags$div( - id = transform_wrapper_id, - if (is.null(data_mod$ui)) { - return(NULL) - } else { - data_mod$ui(id = ns("transform")) - }, - div( - id = ns("validate_messages"), - class = "teal_validated", - uiOutput(ns("error_wrapper")) - ) - ) + + transform_ui <- if (is.null(data_mod$ui)) NULL else data_mod$ui(id = ns("transform")) + + result <- bslib::accordion( + id = ns("wrapper"), + bslib::accordion_panel( + attr(data_mod, "label", exact = TRUE), + icon = bsicons::bs_icon("palette-fill"), + tags$div( + id = ns(sprintf("wrapper_%s", name)), + ui_module_validation(child_id, transform_ui) # Call under same namespace ) ) ) + + if (is.null(transform_ui)) result <- shinyjs::hidden(result) + result } ) } +ui_module_validation <- function(id, transform_ui) { + checkmate::check_string(id) + ns <- NS(id) + + result <- tagList( + div( + id = ns("validate_messages"), + class = "teal_validated", + tags$div( + id = ns("previous-failed"), + class = "teal-output-warning-previous", + "One of previous transformators failed. Please check its inputs." + ), + tags$div( + class = "messages", + module_validate_error$ui(ns("silent_error")), + module_validate_teal_data$ui(ns("class_teal_data")), + module_validate_datanames$ui(ns("datanames_warning")) + ) + ), + transform_ui + ) +} + #' @export #' @rdname module_transform_data srv_transform_teal_data <- function(id, data, transformators, modules = NULL, is_transform_failed = reactiveValues()) { @@ -124,21 +140,16 @@ srv_transform_teal_data <- function(id, data, transformators, modules = NULL, is } }) - transform_wrapper_id <- sprintf("wrapper_%s", name) - output$error_wrapper <- renderUI({ + # transform_wrapper_id <- sprintf("wrapper_%s", name) + + observe({ + is_previous_failed() if (is_previous_failed()) { - shinyjs::disable(transform_wrapper_id) - tags$div( - "One of previous transformators failed. Please check its inputs.", - class = "teal-output-warning" - ) + shinyjs::addClass("validate_messages", "previous-failed") + shinyjs::disable("wrapper") } else { - shinyjs::enable(transform_wrapper_id) - shiny::tagList( - module_validate_error$ui(session$ns("silent_error")), - module_validate_teal_data$ui(session$ns("class_teal_data")), - module_validate_datanames$ui(session$ns("datanames_warning")) - ) + shinyjs::removeClass("validate_messages", "previous-failed") + shinyjs::enable("wrapper") } }) }) diff --git a/R/teal_transform_module.R b/R/teal_transform_module.R index 71ba28ca1b..6cebd63150 100644 --- a/R/teal_transform_module.R +++ b/R/teal_transform_module.R @@ -146,7 +146,6 @@ teal_transform_module <- function(ui = NULL, ) } - decorate_err_msg( assert_reactive(data_out), pre = sprintf("From: 'teal_transform_module()':\nA 'teal_transform_module' with \"%s\" label:", label), diff --git a/inst/css/validation.css b/inst/css/validation.css index 9e14e5eed2..cc17907466 100644 --- a/inst/css/validation.css +++ b/inst/css/validation.css @@ -1,89 +1,73 @@ -/* adding boarder to the validated input */ -.teal_validated:has(.shiny-output-error) { - border: 1px solid red; - border-radius: 4px; -} +.teal_validated { padding: 1em; } +.sidebar .teal_validated { padding: 0.2em; } -.teal_validated:has(.teal-output-warning) { - border: 1px solid orange; +.teal_validated:has(.shiny-output-error), +.teal_validated:has(.teal-output-warning), +.teal_validated:has(.teal-output-warning-previous) { + border: solid 1px transparent; border-radius: 4px; } -.teal_validated .teal-output-warning { - color: #888; +.teal_validated:has(.shiny-output-error) { + border-color: red; + background-color: rgba(223, 70, 97, 0.05); } -.teal-output-condition { - white-space: normal; - line-height: 2em; +.teal_validated:has(.teal-output-warning), +.teal_validated.previous-failed .teal-output-warning-previous { + color: rgb(179, 98, 0); + border-color: orange; + background-color: rgba(255, 165, 0, 0.05); } -.teal-output-condition .prewrap-ws { - white-space: pre-wrap; -} +.teal-output-condition { white-space: normal; } +.teal-output-condition .prewrap-ws { white-space: pre-wrap; } .teal_validated .shiny-output-error, -.teal_validated .teal-output-warning { +.teal_validated .teal-output-warning, +.teal_validated.previous-failed .teal-output-warning-previous { display: flex; - margin-top: 0.5em; - margin-bottom: 0.5em; + margin: 0.5em 0, 0em 0; } -.teal_validated .shiny-output-error > div, -.teal_validated .teal-output-warning > div { +.sidebar .teal_validated .shiny-output-error, +.sidebar .teal_validated .teal-output-warning, +.sidebar .teal_validated.previous-failed .teal-output-warning-previous { display: flex; - flex-direction: column; + margin: 0.2em 0, 0.2em 0; } -.teal_validated .shiny-output-error p, -.teal_validated .teal-output-warning p{ - margin-bottom: 0; +.teal_validated .shiny-output-error > div, +.teal_validated .teal-output-warning > div, +.teal_validated.previous-failed .teal-output-warning-previous > div { + display: flex; + flex-direction: column; + width: 100%; } .teal_validated .teal-output-warning::before, -.teal_validated .shiny-output-error::before, -.teal_primary_col .shiny-output-error::before, -.teal_primary_col .teal-output-warning::before { - padding-left: 0.3em; - padding-right: 0.3em; -} - -.teal_validated .teal-output-warning::before { +.teal_validated .teal-output-warning-previous::before { content: "\26A0\FE0F"; + padding: 0 0.3em 0 0.3em; } .teal_validated .shiny-output-error::before { content: "\1F6A8"; + padding: 0 0.3em 0 0.3em; } -.teal_primary_col .shiny-output-error::before { - content: "\1F6A8"; -} - -.teal_primary_col .teal-output-warning::before { - content: "\26A0\FE0F"; -} - -.teal_primary_col .teal_validated:has(.shiny-output-error), -.teal_primary_col .teal_validated:has(.teal-output-warning) { - margin: 1em 0 1em 0; - padding: 0.5em 0 0.5em 0.5em; -} - -.teal_primary_col > .teal_validated:has(.teal-output-warning), -.teal_primary_col > .teal_validated:has(.shiny-output-error) { - width: 100%; - background-color: rgba(223, 70, 97, 0.1); - border: 1px solid red; - padding: 1em; -} - -.code-error { - margin-left: 1em; -} +.code-error { margin-left: 1em; } +.sidebar .code-error { margin-left: 0.3em; } .teal-sidebar .teal-output-condition blockcode, .teal-sidebar .teal-output-condition .code-error { padding-left: 0; margin-left: 0; } + +.teal_validated.previous-failed .messages, +.teal_validated .teal-output-warning-previous { + display: none; +} + +.teal_validated.previous-failed .teal-output-warning-previous { display: flex; } From 4a8bfaa2f69033ae3e2c94023016267df97142df Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Thu, 3 Apr 2025 23:26:07 +0100 Subject: [PATCH 15/50] cleanup: comment cleanup --- R/module_validate.R | 33 ++++++++------------------------- 1 file changed, 8 insertions(+), 25 deletions(-) diff --git a/R/module_validate.R b/R/module_validate.R index 38911a958c..bc923cb86c 100644 --- a/R/module_validate.R +++ b/R/module_validate.R @@ -45,12 +45,9 @@ module_validate_factory <- function(...) { dots <- rlang::list2(...) checkmate::check_list(dots, min.len = 1) - # Capture function names in arguments - fun_names <- match.call(expand.dots = FALSE)[["..."]] + fun_names <- match.call(expand.dots = FALSE)[["..."]] # Capture function names in arguments - # Generate calls to each of the check functions - # TODO: extract from here - check_calls <- lapply( + check_calls <- lapply( # Generate calls to each of the check functions # TODO: extract from here seq_len(length(dots)), function(fun_ix) { fun_name <- fun_names[[fun_ix]] @@ -68,19 +65,15 @@ module_validate_factory <- function(...) { } ) - # Empty server template - new_server_fun = function(id) TRUE - - # Union of formals for all check functions (order of arguments is kept) - # Conflicting argument name/default will throw an exception. - top_level_formals <- Reduce( + new_server_fun = function(id) TRUE # Empty server template + top_level_formals <- Reduce( # Union of formals for all check functions (order of arguments is kept) function(u, v) { new_formals <- formals(v) common <- intersect(names(new_formals), names(u)) vapply(common, function(x_name) { if (identical(new_formals[[x_name]], u[[x_name]])) { TRUE - } else { + } else { # Conflicting argument name/default will throw an exception. stop("Arguments for check function have conflicting definitions (different defaults)") } }, FUN.VALUE = logical(1L)) @@ -91,9 +84,7 @@ module_validate_factory <- function(...) { ) template_str = "check_calls" - - # Template moduleServer that supports multiple checks - module_server_body <- substitute({ + module_server_body <- substitute({ # Template moduleServer that supports multiple checks collection <- list() check_calls @@ -109,9 +100,6 @@ module_validate_factory <- function(...) { output$errors <- renderUI({ error_class <- c("shiny.silent.error", "validation", "error", "condition") if (length(validate_r()) > 0) { - # Custom rendering of errors instead of validate - # this allows for more control over the output (as some show errors in - # html) tagList( !!!lapply( validate_r(), @@ -135,10 +123,8 @@ module_validate_factory <- function(...) { x }, list(check_calls == as.name(template_str))) - # Replace template string with check function calls new_body_list <- .substitute_template(template_str, module_server_body, check_calls) - # Generate top-level moduleServer function with default assertions server_body <- substitute({ checkmate::assert_string(id) # Mandatory id parameter moduleServer(id, function(input, output, session) server_body) @@ -147,8 +133,7 @@ module_validate_factory <- function(...) { formals(new_server_fun) <- top_level_formals # update function formals body(new_server_fun) <- server_body # set the new generated body - # ui function contains a simple "error" element - new_ui_fun <- function(id) uiOutput(NS(id, "errors")) + new_ui_fun <- function(id) uiOutput(NS(id, "errors")) # ui function contains a simple "error" element list(ui = new_ui_fun, server = new_server_fun) } @@ -355,9 +340,7 @@ module_validate_teal_data <- module_validate_factory(srv_module_check_teal_data) srv_module_check_condition <- function(x) { moduleServer("check_error", function(input, output, session) { - reactive({ - # TODO: remove qenv.error - # shiny.silent.errors are handled in a different module + reactive({ # shiny.silent.errors are handled in a different module if (inherits(x(), "error") && !inherits(x(), c("qenv.error", "shiny.silent.error"))) { tagList( tags$span("NEW:: Error detected:"), From c99f7df3d46bdb33a2140d9d71ff8166e9d9c109 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Thu, 3 Apr 2025 23:28:43 +0100 Subject: [PATCH 16/50] cleanup: move module factory to bottom of file --- R/module_validate.R | 83 ++++++--------------------------------------- 1 file changed, 10 insertions(+), 73 deletions(-) diff --git a/R/module_validate.R b/R/module_validate.R index bc923cb86c..0de7a7dc0a 100644 --- a/R/module_validate.R +++ b/R/module_validate.R @@ -184,20 +184,7 @@ srv_module_check_datanames <- function(id, x, modules) { }) } -module_validate_datanames <- module_validate_factory(srv_module_check_datanames) - -#' Validate if an argument is a reactive -#' -#' @param x (`reactive`) A reactive value. -#' @param types (`character`) A character vector with the types that the reactive. -#' @param null.ok (`logical`) If `TRUE`, the `x` argument can be `NULL`. -#' -#' @name module_validate_reactive -#' @seealso [module_validate_factory()] -#' -#' @returns A module that validates the reactive value. -#' -#' @export +#' @keywords internal srv_module_check_reactive <- function(x, types = character(0L), null.ok = FALSE) { reactive_message <- check_reactive(x, null.ok = null.ok) moduleServer("check_reactive", function(input, output, session) { @@ -220,28 +207,7 @@ srv_module_check_reactive <- function(x, types = character(0L), null.ok = FALSE) }) } -#' @rdname module_validate_reactive -#' @param id (`character`) The module id. -#' @usage module_validate_reactive$server(x, types = character(0L), null.ok = FALSE) -#' module_validate_reactive$ui(id) -#' @examples -#' module_validate_reactive$ui("validate_reactive") -#' -#' # Show the generated server function -#' print(module_validate_reactive$server) -#' @export -module_validate_reactive <- module_validate_factory(srv_module_check_reactive) - -#' Validate if an argument contains a `shiny.silent.error` validation error -#' -#' @param x (`reactive`) A reactive value. -#' -#' @name module_validate_shinysilenterror -#' @seealso [module_validate_factory()] -#' -#' @returns A module that validates the reactive value. -#' -#' @export +#' @keywords internal srv_module_check_validation_error <- function(x) { moduleServer("check_validation_error", function(input, output, session) { reactive({ @@ -257,28 +223,7 @@ srv_module_check_validation_error <- function(x) { }) } -#' @rdname module_validate_shinysilenterror -#' @param id (`character`) The module id. -#' @usage module_validate_shinysilenterror$ui(id) -#' module_validate_shinysilenterror$server(x) -#' @examples -#' module_validate_shinysilenterror$ui("validate_reactive") -#' -#' # Show the generated server function -#' print(module_validate_shinysilenterror$server) -#' @export -module_validate_validation_error <- module_validate_factory(srv_module_check_validation_error) - -#' Validate if an argument contains a `shiny.silent.error` -#' -#' @param x (`reactive`) A reactive value. -#' -#' @name module_validate_shinysilenterror -#' @seealso [module_validate_factory()] -#' -#' @returns A module that validates the reactive value. -#' -#' @export +#' @keywords internal srv_module_check_shinysilenterror <- function(x, validate_shiny_silent_error = TRUE) { moduleServer("check_shinysilenterror", function(input, output, session) { reactive({ @@ -291,18 +236,7 @@ srv_module_check_shinysilenterror <- function(x, validate_shiny_silent_error = T }) } -#' @rdname module_validate_shinysilenterror -#' @param id (`character`) The module id. -#' @usage module_validate_shinysilenterror$ui(id) -#' module_validate_shinysilenterror$server(x) -#' @examples -#' module_validate_shinysilenterror$ui("validate_reactive") -#' -#' # Show the generated server function -#' print(module_validate_shinysilenterror$server) -#' @export -module_validate_shinysilenterror <- module_validate_factory(srv_module_check_shinysilenterror) - +#' @keywords internal srv_module_check_teal_data <- function(x) { moduleServer("check_teal_data", function(input, output, session) { @@ -335,8 +269,7 @@ srv_module_check_teal_data <- function(x) { }) } -module_validate_teal_data <- module_validate_factory(srv_module_check_teal_data) - +#' @keywords internal srv_module_check_condition <- function(x) { moduleServer("check_error", function(input, output, session) { @@ -353,8 +286,12 @@ srv_module_check_condition <- function(x) { }) } +module_validate_reactive <- module_validate_factory(srv_module_check_reactive) +module_validate_datanames <- module_validate_factory(srv_module_check_datanames) +module_validate_validation_error <- module_validate_factory(srv_module_check_validation_error) +module_validate_shinysilenterror <- module_validate_factory(srv_module_check_shinysilenterror) +module_validate_teal_data <- module_validate_factory(srv_module_check_teal_data) module_validate_condition <- module_validate_factory(srv_module_check_condition) - module_validate_error <- module_validate_factory( srv_module_check_shinysilenterror, srv_module_check_validation_error, From 7f9c79cc33a27465c7e8128e634e1c2314c382d4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Thu, 3 Apr 2025 23:29:27 +0100 Subject: [PATCH 17/50] cleanup: re-generate docs --- NAMESPACE | 6 --- R/module_validate.R | 2 - man/module_validate_reactive.Rd | 41 ------------------ man/module_validate_shinysilenterror.Rd | 56 ------------------------- 4 files changed, 105 deletions(-) delete mode 100644 man/module_validate_reactive.Rd delete mode 100644 man/module_validate_shinysilenterror.Rd diff --git a/NAMESPACE b/NAMESPACE index 70703693c2..7442ad41b3 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -29,17 +29,11 @@ export(modify_header) export(modify_title) export(module) export(module_validate_factory) -export(module_validate_reactive) -export(module_validate_shinysilenterror) -export(module_validate_validation_error) export(modules) export(new_tdata) export(report_card_template) export(reporter_previewer_module) export(show_rcode_modal) -export(srv_module_check_reactive) -export(srv_module_check_shinysilenterror) -export(srv_module_check_validation_error) export(srv_session_info) export(srv_teal) export(srv_teal_with_splash) diff --git a/R/module_validate.R b/R/module_validate.R index 0de7a7dc0a..cf1b44538a 100644 --- a/R/module_validate.R +++ b/R/module_validate.R @@ -6,8 +6,6 @@ #' Dynamically generation of an `ui` and `server` function that can be used #' internally in teal or in a teal module. #' -#' -#' #' @param module_id (`character(1)`) The module id. #' @param ... (`function`) 1 or more [`shiny::moduleServer()`] functions that #' return a [`shiny::reactive()`] with `TRUE` or a character string detailing diff --git a/man/module_validate_reactive.Rd b/man/module_validate_reactive.Rd deleted file mode 100644 index dd193c1acd..0000000000 --- a/man/module_validate_reactive.Rd +++ /dev/null @@ -1,41 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/module_validate.R -\docType{data} -\name{module_validate_reactive} -\alias{module_validate_reactive} -\alias{srv_module_check_reactive} -\title{Validate if an argument is a reactive} -\format{ -An object of class \code{list} of length 2. -} -\usage{ -srv_module_check_reactive(x, types = character(0L), null.ok = FALSE) - -module_validate_reactive$server(x, types = character(0L), null.ok = FALSE) -module_validate_reactive$ui(id) -} -\arguments{ -\item{x}{(\code{reactive}) A reactive value.} - -\item{types}{(\code{character}) A character vector with the types that the reactive.} - -\item{null.ok}{(\code{logical}) If \code{TRUE}, the \code{x} argument can be \code{NULL}.} - -\item{id}{(\code{character}) The module id.} -} -\value{ -A module that validates the reactive value. -} -\description{ -Validate if an argument is a reactive -} -\examples{ -module_validate_reactive$ui("validate_reactive") - -# Show the generated server function -print(module_validate_reactive$server) -} -\seealso{ -\code{\link[=module_validate_factory]{module_validate_factory()}} -} -\keyword{datasets} diff --git a/man/module_validate_shinysilenterror.Rd b/man/module_validate_shinysilenterror.Rd deleted file mode 100644 index 4d0bb72775..0000000000 --- a/man/module_validate_shinysilenterror.Rd +++ /dev/null @@ -1,56 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/module_validate.R -\docType{data} -\name{module_validate_shinysilenterror} -\alias{module_validate_shinysilenterror} -\alias{srv_module_check_validation_error} -\alias{module_validate_validation_error} -\alias{srv_module_check_shinysilenterror} -\title{Validate if an argument contains a \code{shiny.silent.error} validation error} -\format{ -An object of class \code{list} of length 2. - -An object of class \code{list} of length 2. -} -\usage{ -srv_module_check_validation_error(x) - -module_validate_shinysilenterror$ui(id) -module_validate_shinysilenterror$server(x) - -srv_module_check_shinysilenterror(x, validate_shiny_silent_error = TRUE) - -module_validate_shinysilenterror$ui(id) -module_validate_shinysilenterror$server(x) -} -\arguments{ -\item{x}{(\code{reactive}) A reactive value.} - -\item{id}{(\code{character}) The module id.} -} -\value{ -A module that validates the reactive value. - -A module that validates the reactive value. -} -\description{ -Validate if an argument contains a \code{shiny.silent.error} validation error - -Validate if an argument contains a \code{shiny.silent.error} -} -\examples{ -module_validate_shinysilenterror$ui("validate_reactive") - -# Show the generated server function -print(module_validate_shinysilenterror$server) -module_validate_shinysilenterror$ui("validate_reactive") - -# Show the generated server function -print(module_validate_shinysilenterror$server) -} -\seealso{ -\code{\link[=module_validate_factory]{module_validate_factory()}} - -\code{\link[=module_validate_factory]{module_validate_factory()}} -} -\keyword{datasets} From efb2c802631681eb5f0525d84dbd92c0a5907c4d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Fri, 4 Apr 2025 00:30:57 +0100 Subject: [PATCH 18/50] style: minor corrections and converts to bslib --- inst/css/validation.css | 25 +++++++++++++++++-------- 1 file changed, 17 insertions(+), 8 deletions(-) diff --git a/inst/css/validation.css b/inst/css/validation.css index cc17907466..e401ed5b91 100644 --- a/inst/css/validation.css +++ b/inst/css/validation.css @@ -9,15 +9,20 @@ } .teal_validated:has(.shiny-output-error) { - border-color: red; - background-color: rgba(223, 70, 97, 0.05); + border-color: var(--bs-danger); + background-color: color-mix(in srgb, var(--bs-danger) 5%, transparent); } .teal_validated:has(.teal-output-warning), -.teal_validated.previous-failed .teal-output-warning-previous { - color: rgb(179, 98, 0); - border-color: orange; - background-color: rgba(255, 165, 0, 0.05); +.teal_validated.previous-failed:has(.teal-output-warning-previous) { + color: color-mix(in srgb, var(--bs-danger), black 20%); + border-color: var(--bs-warning) + background-color: color-mix(in srgb, var(--bs-danger) 5%, transparent); +} + +.validation-wrapper .accordion-item:has(.teal_validated.previous-failed) { + background-color: var(--bs-gray-100); + color: var(--bs-gray-600) } .teal-output-condition { white-space: normal; } @@ -27,14 +32,14 @@ .teal_validated .teal-output-warning, .teal_validated.previous-failed .teal-output-warning-previous { display: flex; - margin: 0.5em 0, 0em 0; + margin: 0.5em 0 0em 0; } .sidebar .teal_validated .shiny-output-error, .sidebar .teal_validated .teal-output-warning, .sidebar .teal_validated.previous-failed .teal-output-warning-previous { display: flex; - margin: 0.2em 0, 0.2em 0; + margin: 0.2em 0 0.2em 0; } .teal_validated .shiny-output-error > div, @@ -65,6 +70,10 @@ margin-left: 0; } +.teal_validated p { + margin-bottom: 0; +} + .teal_validated.previous-failed .messages, .teal_validated .teal-output-warning-previous { display: none; From e3c4c637e1cbee7c15f1cd9d811001ec80023cf2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Fri, 4 Apr 2025 00:31:17 +0100 Subject: [PATCH 19/50] feat: abstract validation UI function --- R/module_nested_tabs.R | 2 +- R/module_transform_data.R | 32 +++++++++++++++++++++----------- 2 files changed, 22 insertions(+), 12 deletions(-) diff --git a/R/module_nested_tabs.R b/R/module_nested_tabs.R index 2836b7c030..246587967b 100644 --- a/R/module_nested_tabs.R +++ b/R/module_nested_tabs.R @@ -101,7 +101,7 @@ ui_teal_module.teal_module <- function(id, modules, depth = 0L) { class = "teal_validated", div( class = "teal-output-warning", - "One of transformators failed. Please check its inputs." + "One of the transformators failed. Please check its inputs." ) ) ), diff --git a/R/module_transform_data.R b/R/module_transform_data.R index ac16188f5a..ed6e170cfc 100644 --- a/R/module_transform_data.R +++ b/R/module_transform_data.R @@ -36,12 +36,25 @@ ui_transform_teal_data <- function(id, transformators, class = "well") { result <- bslib::accordion( id = ns("wrapper"), + class = "validation-wrapper", bslib::accordion_panel( attr(data_mod, "label", exact = TRUE), icon = bsicons::bs_icon("palette-fill"), tags$div( id = ns(sprintf("wrapper_%s", name)), - ui_module_validation(child_id, transform_ui) # Call under same namespace + ui_module_validation( + id = child_id, + body_ui = transform_ui, + validation_ui = list( + silent_error = module_validate_error$ui, + class_teal_data = module_validate_teal_data$ui, + datanames_warning = module_validate_datanames$ui + ), + custom_ui = tags$div( + id = ns("previous-failed"), + class = "teal-output-warning-previous", + "One of the previous transformators failed. Please check its inputs." + )) # Call under same namespace ) ) ) @@ -52,27 +65,24 @@ ui_transform_teal_data <- function(id, transformators, class = "well") { ) } -ui_module_validation <- function(id, transform_ui) { +ui_module_validation <- function(id, body_ui, validation_ui = list(), ...) { + dots = rlang::list2(...) checkmate::check_string(id) + checkmate::assert_list(dots, types = c("shiny.tag", "shiny.tag.list")) + checkmate::assert_list(validation_ui, names = "unique", types = "function") ns <- NS(id) result <- tagList( div( id = ns("validate_messages"), class = "teal_validated", - tags$div( - id = ns("previous-failed"), - class = "teal-output-warning-previous", - "One of previous transformators failed. Please check its inputs." - ), + tagList(!!!dots), tags$div( class = "messages", - module_validate_error$ui(ns("silent_error")), - module_validate_teal_data$ui(ns("class_teal_data")), - module_validate_datanames$ui(ns("datanames_warning")) + !!!lapply(names(validation_ui), function(x) validation_ui[[x]](ns(x))) ) ), - transform_ui + body_ui ) } From 4f15db5756f255993422d424d4dcc30f0158aa55 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Fri, 4 Apr 2025 09:59:04 +0100 Subject: [PATCH 20/50] feat: unifying --- R/module_nested_tabs.R | 29 +++------------- R/module_teal.R | 15 ++++----- R/module_teal_data.R | 45 +++++++++---------------- R/module_transform_data.R | 66 ++++++++---------------------------- R/module_validate.R | 71 +++++++++++++++++++++++++++++++++------ inst/css/validation.css | 7 ++-- 6 files changed, 105 insertions(+), 128 deletions(-) diff --git a/R/module_nested_tabs.R b/R/module_nested_tabs.R index 246587967b..799d4e1b1c 100644 --- a/R/module_nested_tabs.R +++ b/R/module_nested_tabs.R @@ -95,22 +95,9 @@ ui_teal_module.teal_module <- function(id, modules, depth = 0L) { args <- c(list(id = ns("module")), modules$ui_args) ui_teal <- tags$div( - shinyjs::hidden( - tags$div( - id = ns("transform_failure_info"), - class = "teal_validated", - div( - class = "teal-output-warning", - "One of the transformators failed. Please check its inputs." - ) - ) - ), tags$div( id = ns("teal_module_ui"), - tags$div( - class = "teal_validated", - module_validate_datanames$ui(ns("validate_datanames")) - ), + module_validate_datanames$ui(ns("validation")), do.call(what = modules$ui, args = args, quote = TRUE) ) ) @@ -348,16 +335,6 @@ srv_teal_module.teal_module <- function(id, any(unlist(reactiveValuesToList(is_transform_failed))) }) - observeEvent(any_transform_failed(), { - if (isTRUE(any_transform_failed())) { - shinyjs::hide("teal_module_ui") - shinyjs::show("transform_failure_info") - } else { - shinyjs::show("teal_module_ui") - shinyjs::hide("transform_failure_info") - } - }) - module_teal_data <- reactive({ req(inherits(transformed_teal_data(), "teal_data")) all_teal_data <- transformed_teal_data() @@ -368,7 +345,9 @@ srv_teal_module.teal_module <- function(id, module_validate_datanames$server( "validate_datanames", x = module_teal_data, - modules = modules + modules = modules, + show_warn = any_transform_failed, + message_warn = "One of the transformators failed. Please check its inputs." ) summary_table <- srv_data_summary("data_summary", module_teal_data) diff --git a/R/module_teal.R b/R/module_teal.R index 1724f7994c..85c7391f10 100644 --- a/R/module_teal.R +++ b/R/module_teal.R @@ -136,16 +136,13 @@ srv_teal <- function(id, data, modules, filter = teal_slices()) { data_handled <- srv_init_data("data", data = data) - validate_ui <- tags$div( - id = session$ns("validate_messages"), - class = "teal_validated", - module_validate_teal_data$ui(session$ns("class_teal_data")), - module_validate_error$ui(session$ns("silent_error")), - module_validate_datanames$ui(session$ns("datanames_warning")) + validate_ui <- module_validate_teal_module$ui(session$ns("validation")) + module_validate_teal_module$server( + "validation", + x = data_handled, + validate_shiny_silent_error = FALSE, + modules = modules ) - module_validate_teal_data$server("class_teal_data", data_handled) - module_validate_error$server("silent_error", x = data_handled, validate_shiny_silent_error = FALSE) - module_validate_datanames$server("datanames_warning", data_handled, modules) data_validated <- .trigger_on_success(data_handled) diff --git a/R/module_teal_data.R b/R/module_teal_data.R index 6e519615dc..117d2381a2 100644 --- a/R/module_teal_data.R +++ b/R/module_teal_data.R @@ -42,11 +42,11 @@ NULL ui_teal_data_module <- function(id, data_module = function(id) NULL) { checkmate::assert_string(id) checkmate::assert_function(data_module, args = "id") - ns <- NS(id) - shiny::tagList( - tags$div(id = ns("wrapper"), data_module(id = ns("data"))), - ui_validate_reactive_teal_data(ns("validate")) + ui_module_validation( + id = id, + body_ui = data_module(id = NS(id, "data")), + validation_ui = list(validation = module_validate_teal_module$ui) ) } @@ -104,19 +104,10 @@ srv_teal_data_module <- function(id, #' @rdname module_teal_data ui_validate_reactive_teal_data <- function(id) { - ns <- NS(id) - tags$div( - div( - id = ns("validate_messages"), - class = "teal_validated", - module_validate_error$ui(ns("silent_error")), - module_validate_teal_data$ui(ns("class_teal_data")), - module_validate_datanames$ui(ns("shiny_warnings")) - ), - div( - class = "teal_validated", - uiOutput(ns("previous_failed")) - ) + ui_module_validation( + id = id, + body_ui = NULL, + validation_ui = list(errors = module_validate_teal_module$ui) ) } @@ -132,18 +123,14 @@ srv_validate_reactive_teal_data <- function(id, # nolint: object_length moduleServer(id, function(input, output, session) { # there is an empty reactive cycle on `init` and `data` has `shiny.silent.error` class - module_validate_error$server("silent_error", x = data, validate_shiny_silent_error = validate_shiny_silent_error) - module_validate_teal_data$server("class_teal_data", data) - module_validate_datanames$server("shiny_warnings", data, modules) - output$previous_failed <- renderUI({ - if (hide_validation_error()) { - shinyjs::hide("validate_messages") - tags$div("One of previous transformators failed. Please check its inputs.", class = "teal-output-warning") - } else { - shinyjs::show("validate_messages") - NULL - } - }) + module_validate_teal_module$server( + "shiny_warnings", + data, + modules = modules, + show_warn = hide_validation_error, + validate_shiny_silent_error = validate_shiny_silent_error, + error_message = "One of the transformators failed. Please check its inputs." + ) .trigger_on_success(data) }) diff --git a/R/module_transform_data.R b/R/module_transform_data.R index ed6e170cfc..7e6ab07c34 100644 --- a/R/module_transform_data.R +++ b/R/module_transform_data.R @@ -32,7 +32,7 @@ ui_transform_teal_data <- function(id, transformators, class = "well") { ns <- NS(child_id) data_mod <- transformators[[name]] - transform_ui <- if (is.null(data_mod$ui)) NULL else data_mod$ui(id = ns("transform")) + body_ui <- if (is.null(data_mod$ui)) NULL else data_mod$ui(id = ns("transform")) result <- bslib::accordion( id = ns("wrapper"), @@ -42,50 +42,18 @@ ui_transform_teal_data <- function(id, transformators, class = "well") { icon = bsicons::bs_icon("palette-fill"), tags$div( id = ns(sprintf("wrapper_%s", name)), - ui_module_validation( - id = child_id, - body_ui = transform_ui, - validation_ui = list( - silent_error = module_validate_error$ui, - class_teal_data = module_validate_teal_data$ui, - datanames_warning = module_validate_datanames$ui - ), - custom_ui = tags$div( - id = ns("previous-failed"), - class = "teal-output-warning-previous", - "One of the previous transformators failed. Please check its inputs." - )) # Call under same namespace + module_validate_teal_module$ui(ns("validation")), + body_ui ) ) ) - if (is.null(transform_ui)) result <- shinyjs::hidden(result) + if (is.null(body_ui)) result <- shinyjs::hidden(result) result } ) } -ui_module_validation <- function(id, body_ui, validation_ui = list(), ...) { - dots = rlang::list2(...) - checkmate::check_string(id) - checkmate::assert_list(dots, types = c("shiny.tag", "shiny.tag.list")) - checkmate::assert_list(validation_ui, names = "unique", types = "function") - ns <- NS(id) - - result <- tagList( - div( - id = ns("validate_messages"), - class = "teal_validated", - tagList(!!!dots), - tags$div( - class = "messages", - !!!lapply(names(validation_ui), function(x) validation_ui[[x]](ns(x))) - ) - ), - body_ui - ) -} - #' @export #' @rdname module_transform_data srv_transform_teal_data <- function(id, data, transformators, modules = NULL, is_transform_failed = reactiveValues()) { @@ -137,11 +105,14 @@ srv_transform_teal_data <- function(id, data, transformators, modules = NULL, is any(idx_failures < idx_this) }) - module_validate_error$server("silent_error", x = data_handled, validate_shiny_silent_error = FALSE) - module_validate_teal_data$server("class_teal_data", data_handled) - if (!is.null(modules)) { - module_validate_datanames$server("datanames_warning", data_handled, modules) - } + module_validate_teal_module$server( + "validation", + x = data_handled, + modules = modules, + validate_shiny_silent_error = FALSE, + show_warn = is_previous_failed, + message_warn = "One of the previous transformators failed. Please check its inputs." + ) # When there is no UI (`ui = NULL`) it should still show the errors observe({ @@ -149,18 +120,9 @@ srv_transform_teal_data <- function(id, data, transformators, modules = NULL, is shinyjs::show("wrapper") } }) - - # transform_wrapper_id <- sprintf("wrapper_%s", name) - + # Disable the UI elements in case of previous error observe({ - is_previous_failed() - if (is_previous_failed()) { - shinyjs::addClass("validate_messages", "previous-failed") - shinyjs::disable("wrapper") - } else { - shinyjs::removeClass("validate_messages", "previous-failed") - shinyjs::enable("wrapper") - } + (if (is_previous_failed()) shinyjs::disable else shinyjs::enable)("wrapper") }) }) diff --git a/R/module_validate.R b/R/module_validate.R index cf1b44538a..ee211e799e 100644 --- a/R/module_validate.R +++ b/R/module_validate.R @@ -39,13 +39,14 @@ #' #' module_validate_factory(check_error, check_numeric) #' @export -module_validate_factory <- function(...) { +module_validate_factory <- function(..., stop_on_first = TRUE, minimal_ui = FALSE) { dots <- rlang::list2(...) checkmate::check_list(dots, min.len = 1) fun_names <- match.call(expand.dots = FALSE)[["..."]] # Capture function names in arguments - check_calls <- lapply( # Generate calls to each of the check functions # TODO: extract from here + # TODO: extract from here + check_calls <- lapply( # Generate calls to each of the check functions seq_len(length(dots)), function(fun_ix) { fun_name <- fun_names[[fun_ix]] @@ -81,6 +82,10 @@ module_validate_factory <- function(...) { x = dots ) + if (stop_on_first) { + top_level_formals <- c(top_level_formals, list(stop_on_first = stop_on_first)) + } + template_str = "check_calls" module_server_body <- substitute({ # Template moduleServer that supports multiple checks collection <- list() @@ -100,7 +105,7 @@ module_validate_factory <- function(...) { if (length(validate_r()) > 0) { tagList( !!!lapply( - validate_r(), + validate_r_expr, function(.x) { html_class <- if (isTRUE(attr(.x[1], "is_warning")) || isTRUE(attr(.x, "is_warning"))) { "teal-output-warning teal-output-condition" @@ -119,7 +124,10 @@ module_validate_factory <- function(...) { }) x - }, list(check_calls == as.name(template_str))) + }, list( + check_calls == as.name(template_str), + validate_r_expr = if (stop_on_first) quote(validate_r()[1]) else quote(validate_r()) + )) new_body_list <- .substitute_template(template_str, module_server_body, check_calls) @@ -131,7 +139,17 @@ module_validate_factory <- function(...) { formals(new_server_fun) <- top_level_formals # update function formals body(new_server_fun) <- server_body # set the new generated body - new_ui_fun <- function(id) uiOutput(NS(id, "errors")) # ui function contains a simple "error" element + new_ui_fun <- if (minimal_ui) { + function(id) uiOutput(NS(id, "errors")) + } else { + function(id) { + div( + id = NS(id, "validate_messages"), + class = "teal_validated", + tags$div(class = "messages", uiOutput(NS(id, "errors"))) + ) + } + } list(ui = new_ui_fun, server = new_server_fun) } @@ -169,14 +187,14 @@ srv_module_check_datanames <- function(id, x, modules) { checkmate::assert_string(id) moduleServer(id, function(input, output, session) { reactive({ - if (inherits(x(), "teal_data")) { + if (!is.null(modules) && inherits(x(), "teal_data")) { is_modules_ok <- check_modules_datanames_html( modules = modules, datanames = names(x()) ) attr(is_modules_ok, "is_warning") <- TRUE is_modules_ok } else { - TRUE # Error handled elsewhere (avoids showing) + TRUE } }) }) @@ -284,8 +302,41 @@ srv_module_check_condition <- function(x) { }) } +#' @keywords internal +srv_module_check_previous_state_warn <- function(x, show_warn = reactive(FALSE), message_warn = "not defined") { + assert_reactive(show_warn) + checkmate::assert( + checkmate::check_string(message_warn), + checkmate::check_class(message_warn, "shiny.tag"), + checkmate::check_class(message_warn, "shiny.tag.list") + ) + + attr(message_warn, "is_warning") <- TRUE + moduleServer("check_shinysilenterror", function(input, output, session) { + reactive(if (show_warn()) message_warn else TRUE) + }) +} + +module_validate_teal_module <- module_validate_factory( + stop_on_first = TRUE, + srv_module_check_previous_state_warn, + # Validate_error + srv_module_check_shinysilenterror, + srv_module_check_validation_error, + srv_module_check_condition, + srv_module_check_reactive, + + srv_module_check_teal_data, + srv_module_check_datanames +) + module_validate_reactive <- module_validate_factory(srv_module_check_reactive) -module_validate_datanames <- module_validate_factory(srv_module_check_datanames) +module_validate_datanames <- module_validate_factory( + stop_on_first = TRUE, + srv_module_check_previous_state_warn, + srv_module_check_datanames +) + module_validate_validation_error <- module_validate_factory(srv_module_check_validation_error) module_validate_shinysilenterror <- module_validate_factory(srv_module_check_shinysilenterror) module_validate_teal_data <- module_validate_factory(srv_module_check_teal_data) @@ -293,6 +344,6 @@ module_validate_condition <- module_validate_factory(srv_module_check_condition) module_validate_error <- module_validate_factory( srv_module_check_shinysilenterror, srv_module_check_validation_error, - srv_module_check_reactive, - srv_module_check_condition + srv_module_check_condition, + srv_module_check_reactive ) diff --git a/inst/css/validation.css b/inst/css/validation.css index e401ed5b91..adfd7f8be7 100644 --- a/inst/css/validation.css +++ b/inst/css/validation.css @@ -9,15 +9,16 @@ } .teal_validated:has(.shiny-output-error) { + color: color-mix(in srgb, var(--bs-danger), black 20%); border-color: var(--bs-danger); background-color: color-mix(in srgb, var(--bs-danger) 5%, transparent); } .teal_validated:has(.teal-output-warning), .teal_validated.previous-failed:has(.teal-output-warning-previous) { - color: color-mix(in srgb, var(--bs-danger), black 20%); + color: color-mix(in srgb, var(--bs-warning), black 50%); border-color: var(--bs-warning) - background-color: color-mix(in srgb, var(--bs-danger) 5%, transparent); + background-color: color-mix(in srgb, var(--bs-warning) 5%, transparent); } .validation-wrapper .accordion-item:has(.teal_validated.previous-failed) { @@ -32,7 +33,7 @@ .teal_validated .teal-output-warning, .teal_validated.previous-failed .teal-output-warning-previous { display: flex; - margin: 0.5em 0 0em 0; + margin: 0 0 0 0; } .sidebar .teal_validated .shiny-output-error, From 508ad4f908928ca61cf25e2cbde2127cdb158575 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Fri, 4 Apr 2025 10:04:30 +0100 Subject: [PATCH 21/50] cleanup: remove unused code --- R/module_teal_data.R | 17 +++++++---------- 1 file changed, 7 insertions(+), 10 deletions(-) diff --git a/R/module_teal_data.R b/R/module_teal_data.R index 117d2381a2..d575c92bbf 100644 --- a/R/module_teal_data.R +++ b/R/module_teal_data.R @@ -43,10 +43,9 @@ ui_teal_data_module <- function(id, data_module = function(id) NULL) { checkmate::assert_string(id) checkmate::assert_function(data_module, args = "id") - ui_module_validation( - id = id, - body_ui = data_module(id = NS(id, "data")), - validation_ui = list(validation = module_validate_teal_module$ui) + tagList( + validation_ui = list(validation = module_validate_teal_module$ui(NS(id, "validation"))), + body_ui = data_module(id = NS(id, "data")) ) } @@ -104,11 +103,9 @@ srv_teal_data_module <- function(id, #' @rdname module_teal_data ui_validate_reactive_teal_data <- function(id) { - ui_module_validation( - id = id, - body_ui = NULL, - validation_ui = list(errors = module_validate_teal_module$ui) - ) + checkmate::assert_string(id) + + module_validate_teal_module$ui(NS(id, "validation")) } #' @rdname module_teal_data @@ -124,7 +121,7 @@ srv_validate_reactive_teal_data <- function(id, # nolint: object_length moduleServer(id, function(input, output, session) { # there is an empty reactive cycle on `init` and `data` has `shiny.silent.error` class module_validate_teal_module$server( - "shiny_warnings", + "validation", data, modules = modules, show_warn = hide_validation_error, From 8a4caf7ace9f4381812bb14f7cd8d8a375015d0d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Fri, 4 Apr 2025 10:20:23 +0100 Subject: [PATCH 22/50] cleanup: minor --- R/module_teal_data.R | 7 +++++-- R/module_validate.R | 16 ++-------------- 2 files changed, 7 insertions(+), 16 deletions(-) diff --git a/R/module_teal_data.R b/R/module_teal_data.R index d575c92bbf..17689e1b59 100644 --- a/R/module_teal_data.R +++ b/R/module_teal_data.R @@ -92,7 +92,7 @@ srv_teal_data_module <- function(id, }) srv_validate_reactive_teal_data( - "validate", + "validation", data = try_module_out, modules = modules, validate_shiny_silent_error = validate_shiny_silent_error, @@ -105,7 +105,10 @@ srv_teal_data_module <- function(id, ui_validate_reactive_teal_data <- function(id) { checkmate::assert_string(id) - module_validate_teal_module$ui(NS(id, "validation")) + tagList( + tags$h4("here are dragons"), + module_validate_teal_module$ui(NS(id, "validation")) + ) } #' @rdname module_teal_data diff --git a/R/module_validate.R b/R/module_validate.R index ee211e799e..955e0ad2c0 100644 --- a/R/module_validate.R +++ b/R/module_validate.R @@ -243,7 +243,7 @@ srv_module_check_validation_error <- function(x) { srv_module_check_shinysilenterror <- function(x, validate_shiny_silent_error = TRUE) { moduleServer("check_shinysilenterror", function(input, output, session) { reactive({ - if (validate_shiny_silent_error && inherits(x(), "shiny.silent.error") && identical(x()$message, "")) { + if (validate_shiny_silent_error) { "NEW:: Shiny silent error was raised" } else { TRUE @@ -290,7 +290,7 @@ srv_module_check_condition <- function(x) { moduleServer("check_error", function(input, output, session) { reactive({ # shiny.silent.errors are handled in a different module - if (inherits(x(), "error") && !inherits(x(), c("qenv.error", "shiny.silent.error"))) { + if (inherits(x(), "error")) { tagList( tags$span("NEW:: Error detected:"), tags$blockquote(tags$em(trimws(x()$message))) @@ -330,20 +330,8 @@ module_validate_teal_module <- module_validate_factory( srv_module_check_datanames ) -module_validate_reactive <- module_validate_factory(srv_module_check_reactive) module_validate_datanames <- module_validate_factory( stop_on_first = TRUE, srv_module_check_previous_state_warn, srv_module_check_datanames ) - -module_validate_validation_error <- module_validate_factory(srv_module_check_validation_error) -module_validate_shinysilenterror <- module_validate_factory(srv_module_check_shinysilenterror) -module_validate_teal_data <- module_validate_factory(srv_module_check_teal_data) -module_validate_condition <- module_validate_factory(srv_module_check_condition) -module_validate_error <- module_validate_factory( - srv_module_check_shinysilenterror, - srv_module_check_validation_error, - srv_module_check_condition, - srv_module_check_reactive -) From 6b7be641456be949df2b09283680ebdc594d88df Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Fri, 4 Apr 2025 10:49:49 +0100 Subject: [PATCH 23/50] cleanup: remove teal_module_data code that is no longer used --- DESCRIPTION | 1 - R/module_init_data.R | 15 +++- R/module_nested_tabs.R | 14 ++- R/module_teal.R | 23 ++++- R/module_teal_data.R | 152 --------------------------------- R/module_transform_data.R | 9 +- man/module_init_data.Rd | 19 ++++- man/module_teal_data.Rd | 81 ------------------ man/module_transform_data.Rd | 4 + man/module_validate_factory.Rd | 2 +- 10 files changed, 77 insertions(+), 243 deletions(-) delete mode 100644 R/module_teal_data.R delete mode 100644 man/module_teal_data.Rd diff --git a/DESCRIPTION b/DESCRIPTION index db457d3c0b..00c5c7f35b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -116,7 +116,6 @@ Collate: 'module_session_info.R' 'module_snapshot_manager.R' 'module_teal.R' - 'module_teal_data.R' 'module_teal_lockfile.R' 'module_teal_with_splash.R' 'module_transform_data.R' diff --git a/R/module_init_data.R b/R/module_init_data.R index 8ad8800ef9..73e3325a32 100644 --- a/R/module_init_data.R +++ b/R/module_init_data.R @@ -20,7 +20,20 @@ #' lies in data control: the first method involves external control, while the second method #' involves control from a custom module within the app. #' -#' For more details, see [`module_teal_data`]. +#' @section data validation: +#' +#' Executed [teal_data_module()] is validated and output is validated for consistency. +#' Output `data` is invalid if: +#' 1. [teal_data_module()] is invalid if server doesn't return `reactive`. **Immediately crashes an app!** +#' 2. `reactive` throws a `shiny.error` - happens when module creating [teal.data::teal_data()] fails. +#' 3. `reactive` returns `qenv.error` - happens when [teal.data::teal_data()] evaluates a failing code. +#' 4. `reactive` object doesn't return [teal.data::teal_data()]. +#' 5. [teal.data::teal_data()] object lacks any `datanames` specified in the `modules` argument. +#' +#' `teal` (observers in `srv_teal`) always waits to render an app until `reactive` `teal_data` is +#' returned. If error 2-4 occurs, relevant error message is displayed to the app user. Once the issue is +#' resolved, the app will continue to run. `teal` guarantees that errors in data don't crash the app +#' (except error 1). #' #' @inheritParams module_teal #' diff --git a/R/module_nested_tabs.R b/R/module_nested_tabs.R index 799d4e1b1c..db9f6c4222 100644 --- a/R/module_nested_tabs.R +++ b/R/module_nested_tabs.R @@ -95,9 +95,10 @@ ui_teal_module.teal_module <- function(id, modules, depth = 0L) { args <- c(list(id = ns("module")), modules$ui_args) ui_teal <- tags$div( + tags$h5("Here be bears 🐻"), + module_validate_datanames$ui(ns("validation")), tags$div( id = ns("teal_module_ui"), - module_validate_datanames$ui(ns("validation")), do.call(what = modules$ui, args = args, quote = TRUE) ) ) @@ -343,13 +344,22 @@ srv_teal_module.teal_module <- function(id, }) module_validate_datanames$server( - "validate_datanames", + "validation", x = module_teal_data, modules = modules, show_warn = any_transform_failed, message_warn = "One of the transformators failed. Please check its inputs." ) + observe({ # Hide main module UI when there are errors with reactive teal_data + print(any_transform_failed()) + if (any_transform_failed()) { + shinyjs::hide("teal_module_ui") + } else { + shinyjs::show("teal_module_ui") + } + }) + summary_table <- srv_data_summary("data_summary", module_teal_data) observeEvent(input$data_summary_toggle, { diff --git a/R/module_teal.R b/R/module_teal.R index 85c7391f10..72d401deb4 100644 --- a/R/module_teal.R +++ b/R/module_teal.R @@ -136,7 +136,10 @@ srv_teal <- function(id, data, modules, filter = teal_slices()) { data_handled <- srv_init_data("data", data = data) - validate_ui <- module_validate_teal_module$ui(session$ns("validation")) + validate_ui <- tagList( + tags$h5("here be mice 🐁"), + module_validate_teal_module$ui(session$ns("validation")) + ) module_validate_teal_module$server( "validation", x = data_handled, @@ -190,8 +193,8 @@ srv_teal <- function(id, data, modules, filter = teal_slices()) { title = icon("fas fa-database"), value = "teal_data_module", tags$div( - ui_init_data(session$ns("data")), - validate_ui + validate_ui, + ui_init_data(session$ns("data")) ) ) ) @@ -231,3 +234,17 @@ srv_teal <- function(id, data, modules, filter = teal_slices()) { invisible(NULL) } + + +.trigger_on_success <- function(data) { + out <- reactiveVal(NULL) + observeEvent(data(), { + if (inherits(data(), "teal_data")) { + if (!identical(data(), out())) { + out(data()) + } + } + }) + + out +} diff --git a/R/module_teal_data.R b/R/module_teal_data.R deleted file mode 100644 index 17689e1b59..0000000000 --- a/R/module_teal_data.R +++ /dev/null @@ -1,152 +0,0 @@ -#' Execute and validate `teal_data_module` -#' -#' This is a low level module to handle `teal_data_module` execution and validation. -#' [teal_transform_module()] inherits from [teal_data_module()] so it is handled by this module too. -#' [srv_teal()] accepts various `data` objects and eventually they are all transformed to `reactive` -#' [teal.data::teal_data()] which is a standard data class in whole `teal` framework. -#' -#' @section data validation: -#' -#' Executed [teal_data_module()] is validated and output is validated for consistency. -#' Output `data` is invalid if: -#' 1. [teal_data_module()] is invalid if server doesn't return `reactive`. **Immediately crashes an app!** -#' 2. `reactive` throws a `shiny.error` - happens when module creating [teal.data::teal_data()] fails. -#' 3. `reactive` returns `qenv.error` - happens when [teal.data::teal_data()] evaluates a failing code. -#' 4. `reactive` object doesn't return [teal.data::teal_data()]. -#' 5. [teal.data::teal_data()] object lacks any `datanames` specified in the `modules` argument. -#' -#' `teal` (observers in `srv_teal`) always waits to render an app until `reactive` `teal_data` is -#' returned. If error 2-4 occurs, relevant error message is displayed to the app user. Once the issue is -#' resolved, the app will continue to run. `teal` guarantees that errors in data don't crash the app -#' (except error 1). -#' -#' @inheritParams module_teal_module -#' @param data_module (`teal_data_module`) -#' @param modules (`teal_modules` or `teal_module`) For `datanames` validation purpose -#' @param validate_shiny_silent_error (`logical`) If `TRUE`, then `shiny.silent.error` is validated and -#' @param is_transform_failed (`reactiveValues`) contains `logical` flags named after each transformator. -#' Help to determine if any previous transformator failed, so that following transformators can be disabled -#' and display a generic failure message. -#' -#' @return `reactive` `teal_data` -#' -#' @rdname module_teal_data -#' @name module_teal_data -#' @keywords internal -NULL - -#' @rdname module_teal_data -#' @aliases ui_teal_data -#' @note -#' `ui_teal_data_module` was renamed from `ui_teal_data`. -ui_teal_data_module <- function(id, data_module = function(id) NULL) { - checkmate::assert_string(id) - checkmate::assert_function(data_module, args = "id") - - tagList( - validation_ui = list(validation = module_validate_teal_module$ui(NS(id, "validation"))), - body_ui = data_module(id = NS(id, "data")) - ) -} - -#' @rdname module_teal_data -#' @aliases srv_teal_data -#' @note -#' `srv_teal_data_module` was renamed from `srv_teal_data`. -srv_teal_data_module <- function(id, - data_module = function(id) NULL, - modules = NULL, - validate_shiny_silent_error = TRUE, - is_transform_failed = reactiveValues()) { - checkmate::assert_string(id) - checkmate::assert_function(data_module, args = "id") - checkmate::assert_multi_class(modules, c("teal_modules", "teal_module"), null.ok = TRUE) - checkmate::assert_class(is_transform_failed, "reactivevalues") - - moduleServer(id, function(input, output, session) { - logger::log_debug("srv_teal_data_module initializing.") - is_transform_failed[[id]] <- FALSE - module_out <- data_module(id = "data") - try_module_out <- reactive(tryCatch(module_out(), error = function(e) e)) - observeEvent(try_module_out(), { - if (!inherits(try_module_out(), "teal_data")) { - is_transform_failed[[id]] <- TRUE - } else { - is_transform_failed[[id]] <- FALSE - } - }) - - is_previous_failed <- reactive({ - idx_this <- which(names(is_transform_failed) == id) - is_transform_failed_list <- reactiveValuesToList(is_transform_failed) - idx_failures <- which(unlist(is_transform_failed_list)) - any(idx_failures < idx_this) - }) - - observeEvent(is_previous_failed(), { - if (is_previous_failed()) { - shinyjs::disable("wrapper") - } else { - shinyjs::enable("wrapper") - } - }) - - srv_validate_reactive_teal_data( - "validation", - data = try_module_out, - modules = modules, - validate_shiny_silent_error = validate_shiny_silent_error, - hide_validation_error = is_previous_failed - ) - }) -} - -#' @rdname module_teal_data -ui_validate_reactive_teal_data <- function(id) { - checkmate::assert_string(id) - - tagList( - tags$h4("here are dragons"), - module_validate_teal_module$ui(NS(id, "validation")) - ) -} - -#' @rdname module_teal_data -srv_validate_reactive_teal_data <- function(id, # nolint: object_length - data, - modules = NULL, - validate_shiny_silent_error = FALSE, - hide_validation_error = reactive(FALSE)) { - checkmate::assert_string(id) - checkmate::assert_multi_class(modules, c("teal_modules", "teal_module"), null.ok = TRUE) - checkmate::assert_flag(validate_shiny_silent_error) - - moduleServer(id, function(input, output, session) { - # there is an empty reactive cycle on `init` and `data` has `shiny.silent.error` class - module_validate_teal_module$server( - "validation", - data, - modules = modules, - show_warn = hide_validation_error, - validate_shiny_silent_error = validate_shiny_silent_error, - error_message = "One of the transformators failed. Please check its inputs." - ) - - .trigger_on_success(data) - }) -} - -# See R/module_validate.R - -.trigger_on_success <- function(data) { - out <- reactiveVal(NULL) - observeEvent(data(), { - if (inherits(data(), "teal_data")) { - if (!identical(data(), out())) { - out(data()) - } - } - }) - - out -} diff --git a/R/module_transform_data.R b/R/module_transform_data.R index 7e6ab07c34..51b3dbafee 100644 --- a/R/module_transform_data.R +++ b/R/module_transform_data.R @@ -3,7 +3,13 @@ #' Module calls [teal_transform_module()] in sequence so that `reactive teal_data` output #' from one module is handed over to the following module's input. #' -#' @inheritParams module_teal_data +#' @inheritParams module_teal_module +#' @param data_module (`teal_data_module`) +#' @param modules (`teal_modules` or `teal_module`) For `datanames` validation purpose +#' @param validate_shiny_silent_error (`logical`) If `TRUE`, then `shiny.silent.error` is validated and +#' @param is_transform_failed (`reactiveValues`) contains `logical` flags named after each transformator. +#' Help to determine if any previous transformator failed, so that following transformators can be disabled +#' and display a generic failure message. #' @inheritParams teal_modules #' @param class (character(1)) CSS class to be added in the `div` wrapper tag. @@ -42,6 +48,7 @@ ui_transform_teal_data <- function(id, transformators, class = "well") { icon = bsicons::bs_icon("palette-fill"), tags$div( id = ns(sprintf("wrapper_%s", name)), + tags$h5("Here be horses 🐎"), module_validate_teal_module$ui(ns("validation")), body_ui ) diff --git a/man/module_init_data.Rd b/man/module_init_data.Rd index 1671322bbf..af59756e07 100644 --- a/man/module_init_data.Rd +++ b/man/module_init_data.Rd @@ -45,8 +45,25 @@ Since the server of \code{\link[=teal_data_module]{teal_data_module()}} must ret methods (1 and 2) produce the same reactive behavior within a \code{teal} application. The distinction lies in data control: the first method involves external control, while the second method involves control from a custom module within the app. +} +} +\section{data validation}{ + -For more details, see \code{\link{module_teal_data}}. +Executed \code{\link[=teal_data_module]{teal_data_module()}} is validated and output is validated for consistency. +Output \code{data} is invalid if: +\enumerate{ +\item \code{\link[=teal_data_module]{teal_data_module()}} is invalid if server doesn't return \code{reactive}. \strong{Immediately crashes an app!} +\item \code{reactive} throws a \code{shiny.error} - happens when module creating \code{\link[teal.data:teal_data]{teal.data::teal_data()}} fails. +\item \code{reactive} returns \code{qenv.error} - happens when \code{\link[teal.data:teal_data]{teal.data::teal_data()}} evaluates a failing code. +\item \code{reactive} object doesn't return \code{\link[teal.data:teal_data]{teal.data::teal_data()}}. +\item \code{\link[teal.data:teal_data]{teal.data::teal_data()}} object lacks any \code{datanames} specified in the \code{modules} argument. } + +\code{teal} (observers in \code{srv_teal}) always waits to render an app until \code{reactive} \code{teal_data} is +returned. If error 2-4 occurs, relevant error message is displayed to the app user. Once the issue is +resolved, the app will continue to run. \code{teal} guarantees that errors in data don't crash the app +(except error 1). } + \keyword{internal} diff --git a/man/module_teal_data.Rd b/man/module_teal_data.Rd deleted file mode 100644 index ae54af938c..0000000000 --- a/man/module_teal_data.Rd +++ /dev/null @@ -1,81 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/module_teal_data.R -\name{module_teal_data} -\alias{module_teal_data} -\alias{ui_teal_data_module} -\alias{ui_teal_data} -\alias{srv_teal_data_module} -\alias{srv_teal_data} -\alias{ui_validate_reactive_teal_data} -\alias{srv_validate_reactive_teal_data} -\title{Execute and validate \code{teal_data_module}} -\usage{ -ui_teal_data_module(id, data_module = function(id) NULL) - -srv_teal_data_module( - id, - data_module = function(id) NULL, - modules = NULL, - validate_shiny_silent_error = TRUE, - is_transform_failed = reactiveValues() -) - -ui_validate_reactive_teal_data(id) - -srv_validate_reactive_teal_data( - id, - data, - modules = NULL, - validate_shiny_silent_error = FALSE, - hide_validation_error = reactive(FALSE) -) -} -\arguments{ -\item{id}{(\code{character(1)}) \code{shiny} module instance id.} - -\item{data_module}{(\code{teal_data_module})} - -\item{modules}{(\code{teal_modules} or \code{teal_module}) For \code{datanames} validation purpose} - -\item{validate_shiny_silent_error}{(\code{logical}) If \code{TRUE}, then \code{shiny.silent.error} is validated and} - -\item{is_transform_failed}{(\code{reactiveValues}) contains \code{logical} flags named after each transformator. -Help to determine if any previous transformator failed, so that following transformators can be disabled -and display a generic failure message.} - -\item{data}{(\code{reactive} returning \code{teal_data})} -} -\value{ -\code{reactive} \code{teal_data} -} -\description{ -This is a low level module to handle \code{teal_data_module} execution and validation. -\code{\link[=teal_transform_module]{teal_transform_module()}} inherits from \code{\link[=teal_data_module]{teal_data_module()}} so it is handled by this module too. -\code{\link[=srv_teal]{srv_teal()}} accepts various \code{data} objects and eventually they are all transformed to \code{reactive} -\code{\link[teal.data:teal_data]{teal.data::teal_data()}} which is a standard data class in whole \code{teal} framework. -} -\note{ -\code{ui_teal_data_module} was renamed from \code{ui_teal_data}. - -\code{srv_teal_data_module} was renamed from \code{srv_teal_data}. -} -\section{data validation}{ - - -Executed \code{\link[=teal_data_module]{teal_data_module()}} is validated and output is validated for consistency. -Output \code{data} is invalid if: -\enumerate{ -\item \code{\link[=teal_data_module]{teal_data_module()}} is invalid if server doesn't return \code{reactive}. \strong{Immediately crashes an app!} -\item \code{reactive} throws a \code{shiny.error} - happens when module creating \code{\link[teal.data:teal_data]{teal.data::teal_data()}} fails. -\item \code{reactive} returns \code{qenv.error} - happens when \code{\link[teal.data:teal_data]{teal.data::teal_data()}} evaluates a failing code. -\item \code{reactive} object doesn't return \code{\link[teal.data:teal_data]{teal.data::teal_data()}}. -\item \code{\link[teal.data:teal_data]{teal.data::teal_data()}} object lacks any \code{datanames} specified in the \code{modules} argument. -} - -\code{teal} (observers in \code{srv_teal}) always waits to render an app until \code{reactive} \code{teal_data} is -returned. If error 2-4 occurs, relevant error message is displayed to the app user. Once the issue is -resolved, the app will continue to run. \code{teal} guarantees that errors in data don't crash the app -(except error 1). -} - -\keyword{internal} diff --git a/man/module_transform_data.Rd b/man/module_transform_data.Rd index fca1273403..2d67a2d6a7 100644 --- a/man/module_transform_data.Rd +++ b/man/module_transform_data.Rd @@ -31,6 +31,10 @@ To learn more check \code{vignette("transform-input-data", package = "teal")}.} \item{is_transform_failed}{(\code{reactiveValues}) contains \code{logical} flags named after each transformator. Help to determine if any previous transformator failed, so that following transformators can be disabled and display a generic failure message.} + +\item{data_module}{(\code{teal_data_module})} + +\item{validate_shiny_silent_error}{(\code{logical}) If \code{TRUE}, then \code{shiny.silent.error} is validated and} } \value{ \code{reactive} \code{teal_data} diff --git a/man/module_validate_factory.Rd b/man/module_validate_factory.Rd index ef18d6be65..140eed5296 100644 --- a/man/module_validate_factory.Rd +++ b/man/module_validate_factory.Rd @@ -4,7 +4,7 @@ \alias{module_validate_factory} \title{Factory to build validate modules} \usage{ -module_validate_factory(...) +module_validate_factory(..., stop_on_first = TRUE, minimal_ui = FALSE) } \arguments{ \item{...}{(\code{function}) 1 or more \code{\link[shiny:moduleServer]{shiny::moduleServer()}} functions that From 1e9696d5dc2c84af8c71559ebea846d238db8e43 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Fri, 4 Apr 2025 10:51:55 +0100 Subject: [PATCH 24/50] docs: rearrange some docs --- R/module_init_data.R | 15 +-------------- R/teal_data_module.R | 15 +++++++++++++++ man/module_init_data.Rd | 19 +------------------ man/teal_data_module.Rd | 19 +++++++++++++++++++ 4 files changed, 36 insertions(+), 32 deletions(-) diff --git a/R/module_init_data.R b/R/module_init_data.R index 73e3325a32..d99119bce9 100644 --- a/R/module_init_data.R +++ b/R/module_init_data.R @@ -20,20 +20,7 @@ #' lies in data control: the first method involves external control, while the second method #' involves control from a custom module within the app. #' -#' @section data validation: -#' -#' Executed [teal_data_module()] is validated and output is validated for consistency. -#' Output `data` is invalid if: -#' 1. [teal_data_module()] is invalid if server doesn't return `reactive`. **Immediately crashes an app!** -#' 2. `reactive` throws a `shiny.error` - happens when module creating [teal.data::teal_data()] fails. -#' 3. `reactive` returns `qenv.error` - happens when [teal.data::teal_data()] evaluates a failing code. -#' 4. `reactive` object doesn't return [teal.data::teal_data()]. -#' 5. [teal.data::teal_data()] object lacks any `datanames` specified in the `modules` argument. -#' -#' `teal` (observers in `srv_teal`) always waits to render an app until `reactive` `teal_data` is -#' returned. If error 2-4 occurs, relevant error message is displayed to the app user. Once the issue is -#' resolved, the app will continue to run. `teal` guarantees that errors in data don't crash the app -#' (except error 1). +#' For more details, see [`teal_data_module`]. #' #' @inheritParams module_teal #' diff --git a/R/teal_data_module.R b/R/teal_data_module.R index 64ed9d9cba..159571b37a 100644 --- a/R/teal_data_module.R +++ b/R/teal_data_module.R @@ -16,6 +16,21 @@ #' #' See vignette `vignette("data-as-shiny-module", package = "teal")` for more details. #' +#' @section data validation: +#' +#' Executed [teal_data_module()] is validated and output is validated for consistency. +#' Output `data` is invalid if: +#' 1. [teal_data_module()] is invalid if server doesn't return `reactive`. **Immediately crashes an app!** +#' 2. `reactive` throws a `shiny.error` - happens when module creating [teal.data::teal_data()] fails. +#' 3. `reactive` returns `qenv.error` - happens when [teal.data::teal_data()] evaluates a failing code. +#' 4. `reactive` object doesn't return [teal.data::teal_data()]. +#' 5. [teal.data::teal_data()] object lacks any `datanames` specified in the `modules` argument. +#' +#' `teal` (observers in `srv_teal`) always waits to render an app until `reactive` `teal_data` is +#' returned. If error 2-4 occurs, relevant error message is displayed to the app user. Once the issue is +#' resolved, the app will continue to run. `teal` guarantees that errors in data don't crash the app +#' (except error 1). +#' #' @param ui (`function(id)`) #' `shiny` module UI function; must only take `id` argument #' @param server (`function(id)`) diff --git a/man/module_init_data.Rd b/man/module_init_data.Rd index af59756e07..e894d93723 100644 --- a/man/module_init_data.Rd +++ b/man/module_init_data.Rd @@ -45,25 +45,8 @@ Since the server of \code{\link[=teal_data_module]{teal_data_module()}} must ret methods (1 and 2) produce the same reactive behavior within a \code{teal} application. The distinction lies in data control: the first method involves external control, while the second method involves control from a custom module within the app. -} -} -\section{data validation}{ - -Executed \code{\link[=teal_data_module]{teal_data_module()}} is validated and output is validated for consistency. -Output \code{data} is invalid if: -\enumerate{ -\item \code{\link[=teal_data_module]{teal_data_module()}} is invalid if server doesn't return \code{reactive}. \strong{Immediately crashes an app!} -\item \code{reactive} throws a \code{shiny.error} - happens when module creating \code{\link[teal.data:teal_data]{teal.data::teal_data()}} fails. -\item \code{reactive} returns \code{qenv.error} - happens when \code{\link[teal.data:teal_data]{teal.data::teal_data()}} evaluates a failing code. -\item \code{reactive} object doesn't return \code{\link[teal.data:teal_data]{teal.data::teal_data()}}. -\item \code{\link[teal.data:teal_data]{teal.data::teal_data()}} object lacks any \code{datanames} specified in the \code{modules} argument. +For more details, see \code{\link{teal_data_module}}. } - -\code{teal} (observers in \code{srv_teal}) always waits to render an app until \code{reactive} \code{teal_data} is -returned. If error 2-4 occurs, relevant error message is displayed to the app user. Once the issue is -resolved, the app will continue to run. \code{teal} guarantees that errors in data don't crash the app -(except error 1). } - \keyword{internal} diff --git a/man/teal_data_module.Rd b/man/teal_data_module.Rd index 683c6d9ef9..cc66d14563 100644 --- a/man/teal_data_module.Rd +++ b/man/teal_data_module.Rd @@ -76,6 +76,25 @@ The code is added to the \verb{@code} slot of the \code{teal_data}. It accepts only inline expressions (both simple and compound) and allows for injecting values into \code{expr} through the \code{...} argument: as \code{name:value} pairs are passed to \code{...}, \code{name} in \code{expr} will be replaced with \code{value.} } +\section{data validation}{ + + +Executed \code{\link[=teal_data_module]{teal_data_module()}} is validated and output is validated for consistency. +Output \code{data} is invalid if: +\enumerate{ +\item \code{\link[=teal_data_module]{teal_data_module()}} is invalid if server doesn't return \code{reactive}. \strong{Immediately crashes an app!} +\item \code{reactive} throws a \code{shiny.error} - happens when module creating \code{\link[teal.data:teal_data]{teal.data::teal_data()}} fails. +\item \code{reactive} returns \code{qenv.error} - happens when \code{\link[teal.data:teal_data]{teal.data::teal_data()}} evaluates a failing code. +\item \code{reactive} object doesn't return \code{\link[teal.data:teal_data]{teal.data::teal_data()}}. +\item \code{\link[teal.data:teal_data]{teal.data::teal_data()}} object lacks any \code{datanames} specified in the \code{modules} argument. +} + +\code{teal} (observers in \code{srv_teal}) always waits to render an app until \code{reactive} \code{teal_data} is +returned. If error 2-4 occurs, relevant error message is displayed to the app user. Once the issue is +resolved, the app will continue to run. \code{teal} guarantees that errors in data don't crash the app +(except error 1). +} + \examples{ tdm <- teal_data_module( ui = function(id) { From 9a547e2df449ac5a99d48b422daa57c653e50b60 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Fri, 4 Apr 2025 10:58:32 +0100 Subject: [PATCH 25/50] cleanup: small optimizations --- R/module_validate.R | 28 ++++++++-------------------- inst/css/validation.css | 4 +--- 2 files changed, 9 insertions(+), 23 deletions(-) diff --git a/R/module_validate.R b/R/module_validate.R index 955e0ad2c0..c387871f23 100644 --- a/R/module_validate.R +++ b/R/module_validate.R @@ -68,13 +68,9 @@ module_validate_factory <- function(..., stop_on_first = TRUE, minimal_ui = FALS top_level_formals <- Reduce( # Union of formals for all check functions (order of arguments is kept) function(u, v) { new_formals <- formals(v) - common <- intersect(names(new_formals), names(u)) - vapply(common, function(x_name) { - if (identical(new_formals[[x_name]], u[[x_name]])) { - TRUE - } else { # Conflicting argument name/default will throw an exception. + vapply(intersect(names(new_formals), names(u)), function(x_name) { + identical(new_formals[[x_name]], u[[x_name]]) || # Conflicting name/default pair will throw an exception. stop("Arguments for check function have conflicting definitions (different defaults)") - } }, FUN.VALUE = logical(1L)) append(u, new_formals[setdiff(names(new_formals), names(u))]) }, @@ -163,23 +159,19 @@ module_validate_factory <- function(..., stop_on_first = TRUE, minimal_ui = FALS #' @param check_calls (`list`) A list of expressions to be injected. #' #' @returns An expression with the `template_str` replaced by the `check_calls`. -#' #' @keywords internal .substitute_template <- function(template_str, module_server_body, check_calls) { # Create server body with expressions for multiple checks # note: using substitute directly will add curly braces around body - # TODO: discuss this approach vs. having curly braces body_list <- as.list(module_server_body)[-1] ix <- which(body_list == as.name(template_str)) - as.call( - c( - quote(`{`), - body_list[seq(1, ix - 1)], - check_calls, - body_list[seq(ix + 1, length(body_list))] - ) - ) + as.call(c( + quote(`{`), + body_list[seq(1, ix - 1)], + check_calls, + body_list[seq(ix + 1, length(body_list))] + )) } #' @keywords internal @@ -255,7 +247,6 @@ srv_module_check_shinysilenterror <- function(x, validate_shiny_silent_error = T #' @keywords internal srv_module_check_teal_data <- function(x) { moduleServer("check_teal_data", function(input, output, session) { - reactive({ if (inherits(x(), "qenv.error")) { # TODO: remove qenv.error details <- attr(x(), "details", exact = TRUE) @@ -288,7 +279,6 @@ srv_module_check_teal_data <- function(x) { #' @keywords internal srv_module_check_condition <- function(x) { moduleServer("check_error", function(input, output, session) { - reactive({ # shiny.silent.errors are handled in a different module if (inherits(x(), "error")) { tagList( @@ -318,7 +308,6 @@ srv_module_check_previous_state_warn <- function(x, show_warn = reactive(FALSE), } module_validate_teal_module <- module_validate_factory( - stop_on_first = TRUE, srv_module_check_previous_state_warn, # Validate_error srv_module_check_shinysilenterror, @@ -331,7 +320,6 @@ module_validate_teal_module <- module_validate_factory( ) module_validate_datanames <- module_validate_factory( - stop_on_first = TRUE, srv_module_check_previous_state_warn, srv_module_check_datanames ) diff --git a/inst/css/validation.css b/inst/css/validation.css index adfd7f8be7..09f6e2ac8c 100644 --- a/inst/css/validation.css +++ b/inst/css/validation.css @@ -71,9 +71,7 @@ margin-left: 0; } -.teal_validated p { - margin-bottom: 0; -} +.teal_validated p { margin-bottom: 0; } .teal_validated.previous-failed .messages, .teal_validated .teal-output-warning-previous { From 6373a30c9974a6646e494f1ec40beccf7626fd84 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Fri, 4 Apr 2025 11:05:41 +0100 Subject: [PATCH 26/50] cleanup: consistent call to show/hide --- R/module_nested_tabs.R | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/R/module_nested_tabs.R b/R/module_nested_tabs.R index db9f6c4222..e770398bb5 100644 --- a/R/module_nested_tabs.R +++ b/R/module_nested_tabs.R @@ -352,12 +352,7 @@ srv_teal_module.teal_module <- function(id, ) observe({ # Hide main module UI when there are errors with reactive teal_data - print(any_transform_failed()) - if (any_transform_failed()) { - shinyjs::hide("teal_module_ui") - } else { - shinyjs::show("teal_module_ui") - } + (if (any_transform_failed()) shinyjs::hide else shinyjs::show)("teal_module_ui") }) summary_table <- srv_data_summary("data_summary", module_teal_data) From df110b41b680de06856843f075c28ac89aae8cbc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Fri, 4 Apr 2025 11:06:44 +0100 Subject: [PATCH 27/50] cleanup: remove debugging UI elements --- R/module_nested_tabs.R | 1 - R/module_teal.R | 5 +---- R/module_transform_data.R | 1 - 3 files changed, 1 insertion(+), 6 deletions(-) diff --git a/R/module_nested_tabs.R b/R/module_nested_tabs.R index e770398bb5..8691ed69c8 100644 --- a/R/module_nested_tabs.R +++ b/R/module_nested_tabs.R @@ -95,7 +95,6 @@ ui_teal_module.teal_module <- function(id, modules, depth = 0L) { args <- c(list(id = ns("module")), modules$ui_args) ui_teal <- tags$div( - tags$h5("Here be bears 🐻"), module_validate_datanames$ui(ns("validation")), tags$div( id = ns("teal_module_ui"), diff --git a/R/module_teal.R b/R/module_teal.R index 72d401deb4..396b7224fd 100644 --- a/R/module_teal.R +++ b/R/module_teal.R @@ -136,10 +136,7 @@ srv_teal <- function(id, data, modules, filter = teal_slices()) { data_handled <- srv_init_data("data", data = data) - validate_ui <- tagList( - tags$h5("here be mice 🐁"), - module_validate_teal_module$ui(session$ns("validation")) - ) + validate_ui <- module_validate_teal_module$ui(session$ns("validation")) module_validate_teal_module$server( "validation", x = data_handled, diff --git a/R/module_transform_data.R b/R/module_transform_data.R index 51b3dbafee..fb190cdb40 100644 --- a/R/module_transform_data.R +++ b/R/module_transform_data.R @@ -48,7 +48,6 @@ ui_transform_teal_data <- function(id, transformators, class = "well") { icon = bsicons::bs_icon("palette-fill"), tags$div( id = ns(sprintf("wrapper_%s", name)), - tags$h5("Here be horses 🐎"), module_validate_teal_module$ui(ns("validation")), body_ui ) From 8df11e7148ffa3af259d86494da0ba3bc07e02d1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Fri, 4 Apr 2025 12:35:03 +0100 Subject: [PATCH 28/50] fix: too much cleanup --- R/module_validate.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/module_validate.R b/R/module_validate.R index c387871f23..5555c4b6d5 100644 --- a/R/module_validate.R +++ b/R/module_validate.R @@ -235,7 +235,7 @@ srv_module_check_validation_error <- function(x) { srv_module_check_shinysilenterror <- function(x, validate_shiny_silent_error = TRUE) { moduleServer("check_shinysilenterror", function(input, output, session) { reactive({ - if (validate_shiny_silent_error) { + if (validate_shiny_silent_error && inherits(x(), "shiny.silent.error" && !identical(x()$message, ""))) { "NEW:: Shiny silent error was raised" } else { TRUE @@ -280,7 +280,7 @@ srv_module_check_teal_data <- function(x) { srv_module_check_condition <- function(x) { moduleServer("check_error", function(input, output, session) { reactive({ # shiny.silent.errors are handled in a different module - if (inherits(x(), "error")) { + if (inherits(x(), "error") && !inherits(x(), "shiny.silent.error")) { tagList( tags$span("NEW:: Error detected:"), tags$blockquote(tags$em(trimws(x()$message))) From e3a4f5064b7567eb6a49fd3c21b2cc70e11d2702 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Mon, 7 Apr 2025 12:31:41 +0100 Subject: [PATCH 29/50] feat: use of srv_ and ui_ to validate instead of list --- R/module_nested_tabs.R | 4 +- R/module_teal.R | 4 +- R/module_transform_data.R | 4 +- R/module_validate.R | 208 +++++++++++++++++++------------------- 4 files changed, 111 insertions(+), 109 deletions(-) diff --git a/R/module_nested_tabs.R b/R/module_nested_tabs.R index 8691ed69c8..63c1f85c91 100644 --- a/R/module_nested_tabs.R +++ b/R/module_nested_tabs.R @@ -95,7 +95,7 @@ ui_teal_module.teal_module <- function(id, modules, depth = 0L) { args <- c(list(id = ns("module")), modules$ui_args) ui_teal <- tags$div( - module_validate_datanames$ui(ns("validation")), + ui_module_validate(ns("validation")), tags$div( id = ns("teal_module_ui"), do.call(what = modules$ui, args = args, quote = TRUE) @@ -342,7 +342,7 @@ srv_teal_module.teal_module <- function(id, all_teal_data[c(module_datanames, ".raw_data")] }) - module_validate_datanames$server( + srv_module_validate_datanames( "validation", x = module_teal_data, modules = modules, diff --git a/R/module_teal.R b/R/module_teal.R index 396b7224fd..cf257967ff 100644 --- a/R/module_teal.R +++ b/R/module_teal.R @@ -136,8 +136,8 @@ srv_teal <- function(id, data, modules, filter = teal_slices()) { data_handled <- srv_init_data("data", data = data) - validate_ui <- module_validate_teal_module$ui(session$ns("validation")) - module_validate_teal_module$server( + validate_ui <- ui_module_validate(session$ns("validation")) + srv_module_validate_teal_module( "validation", x = data_handled, validate_shiny_silent_error = FALSE, diff --git a/R/module_transform_data.R b/R/module_transform_data.R index fb190cdb40..66f1071609 100644 --- a/R/module_transform_data.R +++ b/R/module_transform_data.R @@ -48,7 +48,7 @@ ui_transform_teal_data <- function(id, transformators, class = "well") { icon = bsicons::bs_icon("palette-fill"), tags$div( id = ns(sprintf("wrapper_%s", name)), - module_validate_teal_module$ui(ns("validation")), + ui_module_validate(ns("validation")), body_ui ) ) @@ -111,7 +111,7 @@ srv_transform_teal_data <- function(id, data, transformators, modules = NULL, is any(idx_failures < idx_this) }) - module_validate_teal_module$server( + srv_module_validate_teal_module( "validation", x = data_handled, modules = modules, diff --git a/R/module_validate.R b/R/module_validate.R index 5555c4b6d5..51983f3df3 100644 --- a/R/module_validate.R +++ b/R/module_validate.R @@ -39,115 +39,126 @@ #' #' module_validate_factory(check_error, check_numeric) #' @export -module_validate_factory <- function(..., stop_on_first = TRUE, minimal_ui = FALSE) { +module_validate_factory <- function(..., stop_on_first = TRUE) { dots <- rlang::list2(...) checkmate::check_list(dots, min.len = 1) + checkmate::assert_flag(stop_on_first) fun_names <- match.call(expand.dots = FALSE)[["..."]] # Capture function names in arguments - - # TODO: extract from here check_calls <- lapply( # Generate calls to each of the check functions - seq_len(length(dots)), + seq_along(dots), function(fun_ix) { - fun_name <- fun_names[[fun_ix]] - fun_formals <- formals(dots[[fun_ix]]) - substitute( - expr, - list( - expr = substitute( - collection <- append(collection, check_call), - list(check_call = rlang::call2(fun_name, !!!lapply(names(fun_formals), as.name))) - ) + collection <- append(collection, check_call), + list(check_call = rlang::call2( + fun_names[[fun_ix]], !!!lapply(names(formals(dots[[fun_ix]])), as.name)) ) ) } ) new_server_fun = function(id) TRUE # Empty server template - top_level_formals <- Reduce( # Union of formals for all check functions (order of arguments is kept) - function(u, v) { - new_formals <- formals(v) - vapply(intersect(names(new_formals), names(u)), function(x_name) { - identical(new_formals[[x_name]], u[[x_name]]) || # Conflicting name/default pair will throw an exception. - stop("Arguments for check function have conflicting definitions (different defaults)") - }, FUN.VALUE = logical(1L)) - append(u, new_formals[setdiff(names(new_formals), names(u))]) - }, - init = formals(new_server_fun), - x = dots - ) - + server_formals <- .join_formals(formals(new_server_fun), dots) if (stop_on_first) { - top_level_formals <- c(top_level_formals, list(stop_on_first = stop_on_first)) + server_formals <- c(server_formals, pairlist(stop_on_first = stop_on_first)) } - template_str = "check_calls" - module_server_body <- substitute({ # Template moduleServer that supports multiple checks - collection <- list() - check_calls - - validate_r <- reactive({ - message_collection <- Reduce( - function(u, v) if (isTRUE(v()) || is.null(v())) u else append(u, list(v())), - x = collection, - init = list() - ) - message_collection - }) - - output$errors <- renderUI({ - error_class <- c("shiny.silent.error", "validation", "error", "condition") - if (length(validate_r()) > 0) { - tagList( - !!!lapply( - validate_r_expr, - function(.x) { - html_class <- if (isTRUE(attr(.x[1], "is_warning")) || isTRUE(attr(.x, "is_warning"))) { - "teal-output-warning teal-output-condition" - } else { - "shiny-output-error teal-output-condition" - } - if (!checkmate::test_multi_class(.x, c("shiny.tag", "shiny.tag.list"))) { - html_class <- c(html_class, "prewrap-ws") - .x <- lapply(.x, tags$p) - } - tags$div(class = html_class, tags$div(.x)) - } - ) - ) - } - }) - - x - }, list( - check_calls == as.name(template_str), - validate_r_expr = if (stop_on_first) quote(validate_r()[1]) else quote(validate_r()) - )) - - new_body_list <- .substitute_template(template_str, module_server_body, check_calls) + new_body_list <- .generate_module_server_body(check_calls, stop_on_first = stop_on_first) server_body <- substitute({ checkmate::assert_string(id) # Mandatory id parameter moduleServer(id, function(input, output, session) server_body) }, list(server_body = new_body_list)) - formals(new_server_fun) <- top_level_formals # update function formals + formals(new_server_fun) <- server_formals # update function formals body(new_server_fun) <- server_body # set the new generated body - new_ui_fun <- if (minimal_ui) { - function(id) uiOutput(NS(id, "errors")) - } else { - function(id) { - div( - id = NS(id, "validate_messages"), - class = "teal_validated", - tags$div(class = "messages", uiOutput(NS(id, "errors"))) - ) - } + server = new_server_fun +} + +ui_module_validate <- function(id) { + div( + id = NS(id, "validate_messages"), + class = "teal_validated", + tags$div(class = "messages", uiOutput(NS(id, "errors"))) + ) +} + +#' @keywords internal +.generate_module_server_body <- function(check_calls, + stop_on_first, + template_str = "check_calls") { + module_server_body <- substitute( + { # Template moduleServer that supports multiple checks + collection <- list() + check_calls + + fun <- function(u, v) if (isTRUE(v()) || is.null(v())) u else append(u, list(v())) + validate_r <- reactive({ + message_collection <- Reduce(fun, x = collection, init = list()) + message_collection + }) + + has_errors <- reactiveVal(TRUE) + + output$errors <- renderUI({ + error_class <- c("shiny.silent.error", "validation", "error", "condition") + if (length(validate_r()) > 0) { + has_errors(FALSE) + tagList(!!!lapply(validate_r_expr, .render_output_condition)) + } else { + has_errors(TRUE) + NULL + } + }) + + has_errors + }, + list( + check_calls == as.name(template_str), + validate_r_expr = if (stop_on_first) quote(validate_r()[1]) else quote(validate_r()) + ) + ) + + .substitute_template(template_str, module_server_body, check_calls) +} + +#' @keywords internal +.render_output_condition <- function(cond) { + checkmate::assert_multi_class(cond, c("shiny.tag", "shiny.tag.list", "character")) + is_warning <- isTRUE(attr(cond[1], "is_warning")) || isTRUE(attr(cond, "is_warning")) + + html_class <- sprintf( + "teal-output-condition %s", + ifelse(is_warning, "teal-output-warning", "shiny-output-error") + ) + + if (!checkmate::test_multi_class(cond, c("shiny.tag", "shiny.tag.list"))) { + html_class <- c(html_class, "prewrap-ws") + cond <- lapply(cond, tags$p) } + tags$div(class = html_class, tags$div(cond)) +} + +#' @keywords internal +.join_formals <- function(current_formals, call_list) { + checkmate::assert( + checkmate::check_list(current_formals), + checkmate::check_class(current_formals, "pairlist") + ) + Reduce( # Union of formals for all check functions (order of arguments is kept) + function(u, v) { + new_formals <- formals(v) + vapply(intersect(names(new_formals), names(u)), function(x_name) { + identical(new_formals[[x_name]], u[[x_name]]) || # Conflicting name/default pair will throw an exception. + stop("Arguments for check function have conflicting definitions (different defaults)") + }, FUN.VALUE = logical(1L)) + append(u, new_formals[setdiff(names(new_formals), names(u))]) + }, + init = current_formals, + x = call_list + ) - list(ui = new_ui_fun, server = new_server_fun) } #' Custom substitute function that injects multiple lines to an expression @@ -193,23 +204,14 @@ srv_module_check_datanames <- function(id, x, modules) { } #' @keywords internal -srv_module_check_reactive <- function(x, types = character(0L), null.ok = FALSE) { +srv_module_check_reactive <- function(x, null.ok = FALSE) { reactive_message <- check_reactive(x, null.ok = null.ok) moduleServer("check_reactive", function(input, output, session) { - reactive({ if (isTRUE(reactive_message)) { - if (length(types) > 0 && !inherits(x(), types)) { - sprintf( - "Reactive value's class may only of the following types: %s, but it is '%s'", - paste("{", types, "}", sep = "", collapse = ", "), - paste("{", class(x()), "}", sep = "", collapse = ", ") - ) - } else { - TRUE - } + reactive_message } else { - paste0("NEW:: ", reactive_message) + TRUE } }) }) @@ -221,7 +223,7 @@ srv_module_check_validation_error <- function(x) { reactive({ if (checkmate::test_class(x(), c("shiny.silent.error", "validation")) && !identical(x()$message, "")) { tagList( - tags$span("NEW:: Shiny validation error was raised:"), + tags$span("Shiny validation error was raised:"), tags$blockquote(tags$em(x()$message)) ) } else { @@ -236,7 +238,7 @@ srv_module_check_shinysilenterror <- function(x, validate_shiny_silent_error = T moduleServer("check_shinysilenterror", function(input, output, session) { reactive({ if (validate_shiny_silent_error && inherits(x(), "shiny.silent.error" && !identical(x()$message, ""))) { - "NEW:: Shiny silent error was raised" + "Shiny silent error was raised" } else { TRUE } @@ -252,14 +254,14 @@ srv_module_check_teal_data <- function(x) { details <- attr(x(), "details", exact = TRUE) if (is.null(details)) { c( - "NEW:: Error when executing the `data` module:", + "Error when executing the `data` module:", cli::ansi_strip(x()$message), "", "Check your inputs or contact app developer if error persists." ) } else { tagList( - tags$span("NEW:: Error when executing the", tags$code("data"), "module:"), + tags$span("Error when executing the", tags$code("data"), "module:"), tags$blockquote(tags$em(cli::ansi_strip(details$condition_message))), tags$span("from code:"), tags$code(class = "code-error", details$current_code) @@ -267,7 +269,7 @@ srv_module_check_teal_data <- function(x) { } } else if (!inherits(x(), c("teal_data", "error"))) { tags$span( - "NEW:: Did not receive", tags$code("teal_data"), "object. Cannot proceed further." + "Did not receive", tags$code("teal_data"), "object. Cannot proceed further." ) } else { TRUE @@ -282,7 +284,7 @@ srv_module_check_condition <- function(x) { reactive({ # shiny.silent.errors are handled in a different module if (inherits(x(), "error") && !inherits(x(), "shiny.silent.error")) { tagList( - tags$span("NEW:: Error detected:"), + tags$span("Error detected:"), tags$blockquote(tags$em(trimws(x()$message))) ) } else { @@ -307,7 +309,7 @@ srv_module_check_previous_state_warn <- function(x, show_warn = reactive(FALSE), }) } -module_validate_teal_module <- module_validate_factory( +srv_module_validate_teal_module <- module_validate_factory( srv_module_check_previous_state_warn, # Validate_error srv_module_check_shinysilenterror, @@ -319,7 +321,7 @@ module_validate_teal_module <- module_validate_factory( srv_module_check_datanames ) -module_validate_datanames <- module_validate_factory( +srv_module_validate_datanames <- module_validate_factory( srv_module_check_previous_state_warn, srv_module_check_datanames ) From 27723372bd4141e363c56ece3d51acbc07967c46 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 8 Apr 2025 11:29:46 +0100 Subject: [PATCH 30/50] feat: use bquote and splicing --- R/module_transform_data.R | 3 +- R/module_validate.R | 74 +++++++++++++-------------------------- 2 files changed, 25 insertions(+), 52 deletions(-) diff --git a/R/module_transform_data.R b/R/module_transform_data.R index 66f1071609..473ebbca89 100644 --- a/R/module_transform_data.R +++ b/R/module_transform_data.R @@ -111,10 +111,9 @@ srv_transform_teal_data <- function(id, data, transformators, modules = NULL, is any(idx_failures < idx_this) }) - srv_module_validate_teal_module( + srv_module_validate_transform( "validation", x = data_handled, - modules = modules, validate_shiny_silent_error = FALSE, show_warn = is_previous_failed, message_warn = "One of the previous transformators failed. Please check its inputs." diff --git a/R/module_validate.R b/R/module_validate.R index 51983f3df3..d159b5ef4c 100644 --- a/R/module_validate.R +++ b/R/module_validate.R @@ -62,18 +62,10 @@ module_validate_factory <- function(..., stop_on_first = TRUE) { if (stop_on_first) { server_formals <- c(server_formals, pairlist(stop_on_first = stop_on_first)) } - - new_body_list <- .generate_module_server_body(check_calls, stop_on_first = stop_on_first) - - server_body <- substitute({ - checkmate::assert_string(id) # Mandatory id parameter - moduleServer(id, function(input, output, session) server_body) - }, list(server_body = new_body_list)) - + server_body <- .validate_module_server(check_calls, stop_on_first = stop_on_first) formals(new_server_fun) <- server_formals # update function formals body(new_server_fun) <- server_body # set the new generated body - - server = new_server_fun + new_server_fun } ui_module_validate <- function(id) { @@ -85,13 +77,12 @@ ui_module_validate <- function(id) { } #' @keywords internal -.generate_module_server_body <- function(check_calls, - stop_on_first, - template_str = "check_calls") { - module_server_body <- substitute( +.validate_module_server <- function(check_calls, stop_on_first) { + validate_r_expr <- if (stop_on_first) quote(validate_r()[1]) else quote(validate_r()) + module_server_body <- bquote( { # Template moduleServer that supports multiple checks collection <- list() - check_calls + ..(check_calls) fun <- function(u, v) if (isTRUE(v()) || is.null(v())) u else append(u, list(v())) validate_r <- reactive({ @@ -105,7 +96,7 @@ ui_module_validate <- function(id) { error_class <- c("shiny.silent.error", "validation", "error", "condition") if (length(validate_r()) > 0) { has_errors(FALSE) - tagList(!!!lapply(validate_r_expr, .render_output_condition)) + tagList(!!!lapply(.(validate_r_expr), .render_output_condition)) } else { has_errors(TRUE) NULL @@ -114,13 +105,14 @@ ui_module_validate <- function(id) { has_errors }, - list( - check_calls == as.name(template_str), - validate_r_expr = if (stop_on_first) quote(validate_r()[1]) else quote(validate_r()) - ) + splice = TRUE ) - .substitute_template(template_str, module_server_body, check_calls) + substitute({ + checkmate::assert_string(id) # Mandatory id parameter + moduleServer(id, function(input, output, session) server_body) + }, list(server_body = module_server_body)) + } #' @keywords internal @@ -161,34 +153,9 @@ ui_module_validate <- function(id) { } -#' Custom substitute function that injects multiple lines to an expression -#' -#' It must contain the `template_str` on the first level of the expression. -#' -#' @param template_str (`character(1)`) The call in the expression to be replaced. -#' @param module_server_body (`expression`) Any syntactically valid R expression. -#' @param check_calls (`list`) A list of expressions to be injected. -#' -#' @returns An expression with the `template_str` replaced by the `check_calls`. -#' @keywords internal -.substitute_template <- function(template_str, module_server_body, check_calls) { - # Create server body with expressions for multiple checks - # note: using substitute directly will add curly braces around body - body_list <- as.list(module_server_body)[-1] - ix <- which(body_list == as.name(template_str)) - - as.call(c( - quote(`{`), - body_list[seq(1, ix - 1)], - check_calls, - body_list[seq(ix + 1, length(body_list))] - )) -} - #' @keywords internal -srv_module_check_datanames <- function(id, x, modules) { - checkmate::assert_string(id) - moduleServer(id, function(input, output, session) { +srv_module_check_datanames <- function(x, modules) { + moduleServer("check_datanames", function(input, output, session) { reactive({ if (!is.null(modules) && inherits(x(), "teal_data")) { is_modules_ok <- check_modules_datanames_html( @@ -311,16 +278,23 @@ srv_module_check_previous_state_warn <- function(x, show_warn = reactive(FALSE), srv_module_validate_teal_module <- module_validate_factory( srv_module_check_previous_state_warn, - # Validate_error srv_module_check_shinysilenterror, srv_module_check_validation_error, srv_module_check_condition, srv_module_check_reactive, - srv_module_check_teal_data, srv_module_check_datanames ) +srv_module_validate_transform <- module_validate_factory( + srv_module_check_previous_state_warn, + srv_module_check_shinysilenterror, + srv_module_check_validation_error, + srv_module_check_condition, + srv_module_check_reactive, + srv_module_check_teal_data +) + srv_module_validate_datanames <- module_validate_factory( srv_module_check_previous_state_warn, srv_module_check_datanames From 6ea756e90a7b386b2fde9875d8664d2975e5e24d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 8 Apr 2025 11:40:32 +0100 Subject: [PATCH 31/50] feat: improve on stop_on_first implementation --- R/module_validate.R | 16 +++++++--------- 1 file changed, 7 insertions(+), 9 deletions(-) diff --git a/R/module_validate.R b/R/module_validate.R index d159b5ef4c..5005585baa 100644 --- a/R/module_validate.R +++ b/R/module_validate.R @@ -78,25 +78,23 @@ ui_module_validate <- function(id) { #' @keywords internal .validate_module_server <- function(check_calls, stop_on_first) { - validate_r_expr <- if (stop_on_first) quote(validate_r()[1]) else quote(validate_r()) + condition <- if (stop_on_first) quote(length(u) > 0 || isTRUE(v()) || is.null(v())) else quote(isTRUE(v()) || is.null(v())) module_server_body <- bquote( { # Template moduleServer that supports multiple checks collection <- list() - ..(check_calls) - - fun <- function(u, v) if (isTRUE(v()) || is.null(v())) u else append(u, list(v())) - validate_r <- reactive({ - message_collection <- Reduce(fun, x = collection, init = list()) - message_collection - }) + ..(check_calls) # collection <- append(collection, srv_module_check_condition(x)) + fun <- function(u, v) { + if (.(condition)) u else append(u, list(v())) + } + validate_r <- reactive(Reduce(fun, x = collection, init = list())) has_errors <- reactiveVal(TRUE) output$errors <- renderUI({ error_class <- c("shiny.silent.error", "validation", "error", "condition") if (length(validate_r()) > 0) { has_errors(FALSE) - tagList(!!!lapply(.(validate_r_expr), .render_output_condition)) + tagList(!!!lapply(validate_r(), .render_output_condition)) } else { has_errors(TRUE) NULL From a7b81fa92c57997b926732a0df39200918f8ce77 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 8 Apr 2025 11:40:59 +0100 Subject: [PATCH 32/50] chore: move function to oneliner --- R/module_validate.R | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/R/module_validate.R b/R/module_validate.R index 5005585baa..c47b568ca1 100644 --- a/R/module_validate.R +++ b/R/module_validate.R @@ -84,9 +84,7 @@ ui_module_validate <- function(id) { collection <- list() ..(check_calls) # collection <- append(collection, srv_module_check_condition(x)) - fun <- function(u, v) { - if (.(condition)) u else append(u, list(v())) - } + fun <- function(u, v) if (.(condition)) u else append(u, list(v())) validate_r <- reactive(Reduce(fun, x = collection, init = list())) has_errors <- reactiveVal(TRUE) From 0b31102d09c74931390725bcc99e10d828986a3b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 8 Apr 2025 11:45:27 +0100 Subject: [PATCH 33/50] chore: minor cleanup --- R/module_validate.R | 20 ++++++-------------- 1 file changed, 6 insertions(+), 14 deletions(-) diff --git a/R/module_validate.R b/R/module_validate.R index c47b568ca1..276ad51f9e 100644 --- a/R/module_validate.R +++ b/R/module_validate.R @@ -79,8 +79,9 @@ ui_module_validate <- function(id) { #' @keywords internal .validate_module_server <- function(check_calls, stop_on_first) { condition <- if (stop_on_first) quote(length(u) > 0 || isTRUE(v()) || is.null(v())) else quote(isTRUE(v()) || is.null(v())) - module_server_body <- bquote( - { # Template moduleServer that supports multiple checks + module_server_body <- bquote({ # Template moduleServer that supports multiple checks + checkmate::assert_string(id) # Mandatory id parameter + moduleServer(id, function(input, output, session) { collection <- list() ..(check_calls) # collection <- append(collection, srv_module_check_condition(x)) @@ -98,17 +99,9 @@ ui_module_validate <- function(id) { NULL } }) - has_errors - }, - splice = TRUE - ) - - substitute({ - checkmate::assert_string(id) # Mandatory id parameter - moduleServer(id, function(input, output, session) server_body) - }, list(server_body = module_server_body)) - + }) + }, splice = TRUE) } #' @keywords internal @@ -121,7 +114,7 @@ ui_module_validate <- function(id) { ifelse(is_warning, "teal-output-warning", "shiny-output-error") ) - if (!checkmate::test_multi_class(cond, c("shiny.tag", "shiny.tag.list"))) { + if (!checkmate::test_character(cond)) { html_class <- c(html_class, "prewrap-ws") cond <- lapply(cond, tags$p) } @@ -146,7 +139,6 @@ ui_module_validate <- function(id) { init = current_formals, x = call_list ) - } #' @keywords internal From 45ff32c8b4d028894786326e61a351babee3ece6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 8 Apr 2025 11:55:06 +0100 Subject: [PATCH 34/50] chore: fix linter problems --- R/module_validate.R | 37 ++++++++++++++++--------------------- 1 file changed, 16 insertions(+), 21 deletions(-) diff --git a/R/module_validate.R b/R/module_validate.R index 276ad51f9e..5ca8727f58 100644 --- a/R/module_validate.R +++ b/R/module_validate.R @@ -38,7 +38,7 @@ #' } #' #' module_validate_factory(check_error, check_numeric) -#' @export +#' @keywords internal module_validate_factory <- function(..., stop_on_first = TRUE) { dots <- rlang::list2(...) checkmate::check_list(dots, min.len = 1) @@ -50,14 +50,12 @@ module_validate_factory <- function(..., stop_on_first = TRUE) { function(fun_ix) { substitute( collection <- append(collection, check_call), - list(check_call = rlang::call2( - fun_names[[fun_ix]], !!!lapply(names(formals(dots[[fun_ix]])), as.name)) - ) + list(check_call = rlang::call2(fun_names[[fun_ix]], !!!lapply(names(formals(dots[[fun_ix]])), as.name))) ) } ) - new_server_fun = function(id) TRUE # Empty server template + new_server_fun <- function(id) TRUE # Empty server template server_formals <- .join_formals(formals(new_server_fun), dots) if (stop_on_first) { server_formals <- c(server_formals, pairlist(stop_on_first = stop_on_first)) @@ -78,12 +76,15 @@ ui_module_validate <- function(id) { #' @keywords internal .validate_module_server <- function(check_calls, stop_on_first) { - condition <- if (stop_on_first) quote(length(u) > 0 || isTRUE(v()) || is.null(v())) else quote(isTRUE(v()) || is.null(v())) + condition <- if (stop_on_first) + quote(length(u) > 0 || isTRUE(v()) || is.null(v())) + else + quote(isTRUE(v()) || is.null(v())) module_server_body <- bquote({ # Template moduleServer that supports multiple checks checkmate::assert_string(id) # Mandatory id parameter moduleServer(id, function(input, output, session) { collection <- list() - ..(check_calls) # collection <- append(collection, srv_module_check_condition(x)) + ..(check_calls) # Generates expressions: "collection <- append(collection, srv_module_check_xxxx(x))" fun <- function(u, v) if (.(condition)) u else append(u, list(v())) validate_r <- reactive(Reduce(fun, x = collection, init = list())) @@ -159,21 +160,15 @@ srv_module_check_datanames <- function(x, modules) { } #' @keywords internal -srv_module_check_reactive <- function(x, null.ok = FALSE) { +srv_module_check_reactive <- function(x, null.ok = FALSE) { # nolint: object_name_linter. reactive_message <- check_reactive(x, null.ok = null.ok) moduleServer("check_reactive", function(input, output, session) { - reactive({ - if (isTRUE(reactive_message)) { - reactive_message - } else { - TRUE - } - }) + reactive(if (isTRUE(reactive_message)) reactive_message else TRUE) }) } #' @keywords internal -srv_module_check_validation_error <- function(x) { +srv_module_check_validation <- function(x) { moduleServer("check_validation_error", function(input, output, session) { reactive({ if (checkmate::test_class(x(), c("shiny.silent.error", "validation")) && !identical(x()$message, "")) { @@ -189,7 +184,7 @@ srv_module_check_validation_error <- function(x) { } #' @keywords internal -srv_module_check_shinysilenterror <- function(x, validate_shiny_silent_error = TRUE) { +srv_module_check_shinysilenterror <- function(x, validate_shiny_silent_error = TRUE) { # nolint: object_length. moduleServer("check_shinysilenterror", function(input, output, session) { reactive({ if (validate_shiny_silent_error && inherits(x(), "shiny.silent.error" && !identical(x()$message, ""))) { @@ -250,7 +245,7 @@ srv_module_check_condition <- function(x) { } #' @keywords internal -srv_module_check_previous_state_warn <- function(x, show_warn = reactive(FALSE), message_warn = "not defined") { +srv_module_check_previous_state_warn <- function(x, show_warn = reactive(FALSE), message_warn = "not defined") { # nolint: object_length,line_length. assert_reactive(show_warn) checkmate::assert( checkmate::check_string(message_warn), @@ -264,10 +259,10 @@ srv_module_check_previous_state_warn <- function(x, show_warn = reactive(FALSE), }) } -srv_module_validate_teal_module <- module_validate_factory( +srv_module_validate_teal_module <- module_validate_factory( # nolint: object_length. srv_module_check_previous_state_warn, srv_module_check_shinysilenterror, - srv_module_check_validation_error, + srv_module_check_validation, srv_module_check_condition, srv_module_check_reactive, srv_module_check_teal_data, @@ -277,7 +272,7 @@ srv_module_validate_teal_module <- module_validate_factory( srv_module_validate_transform <- module_validate_factory( srv_module_check_previous_state_warn, srv_module_check_shinysilenterror, - srv_module_check_validation_error, + srv_module_check_validation, srv_module_check_condition, srv_module_check_reactive, srv_module_check_teal_data From 0fe809da9bd045c325a5e4ac299ef1ca4afe3cc7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 8 Apr 2025 11:55:27 +0100 Subject: [PATCH 35/50] docs: remove export --- NAMESPACE | 1 - man/dot-substitute_template.Rd | 22 ---------------------- man/module_validate_factory.Rd | 3 ++- 3 files changed, 2 insertions(+), 24 deletions(-) delete mode 100644 man/dot-substitute_template.Rd diff --git a/NAMESPACE b/NAMESPACE index 7442ad41b3..ac53893f97 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -28,7 +28,6 @@ export(modify_footer) export(modify_header) export(modify_title) export(module) -export(module_validate_factory) export(modules) export(new_tdata) export(report_card_template) diff --git a/man/dot-substitute_template.Rd b/man/dot-substitute_template.Rd deleted file mode 100644 index 2a58d316f5..0000000000 --- a/man/dot-substitute_template.Rd +++ /dev/null @@ -1,22 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/module_validate.R -\name{.substitute_template} -\alias{.substitute_template} -\title{Custom substitute function that injects multiple lines to an expression} -\usage{ -.substitute_template(template_str, module_server_body, check_calls) -} -\arguments{ -\item{template_str}{(\code{character(1)}) The call in the expression to be replaced.} - -\item{module_server_body}{(\code{expression}) Any syntactically valid R expression.} - -\item{check_calls}{(\code{list}) A list of expressions to be injected.} -} -\value{ -An expression with the \code{template_str} replaced by the \code{check_calls}. -} -\description{ -It must contain the \code{template_str} on the first level of the expression. -} -\keyword{internal} diff --git a/man/module_validate_factory.Rd b/man/module_validate_factory.Rd index 140eed5296..ae4c59b506 100644 --- a/man/module_validate_factory.Rd +++ b/man/module_validate_factory.Rd @@ -4,7 +4,7 @@ \alias{module_validate_factory} \title{Factory to build validate modules} \usage{ -module_validate_factory(..., stop_on_first = TRUE, minimal_ui = FALSE) +module_validate_factory(..., stop_on_first = TRUE) } \arguments{ \item{...}{(\code{function}) 1 or more \code{\link[shiny:moduleServer]{shiny::moduleServer()}} functions that @@ -50,3 +50,4 @@ check_numeric <- function(x, skip = FALSE) { module_validate_factory(check_error, check_numeric) } +\keyword{internal} From 25b397adbed33c5a58be55b9364cc625fb146dec Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 8 Apr 2025 12:04:55 +0100 Subject: [PATCH 36/50] docs: update --- R/module_teal.R | 14 ++------- R/module_validate.R | 31 +++++++++---------- ...tory.Rd => srv_module_validate_factory.Rd} | 31 +++++++++---------- 3 files changed, 30 insertions(+), 46 deletions(-) rename man/{module_validate_factory.Rd => srv_module_validate_factory.Rd} (53%) diff --git a/R/module_teal.R b/R/module_teal.R index cf257967ff..aa4191f3f7 100644 --- a/R/module_teal.R +++ b/R/module_teal.R @@ -138,10 +138,7 @@ srv_teal <- function(id, data, modules, filter = teal_slices()) { validate_ui <- ui_module_validate(session$ns("validation")) srv_module_validate_teal_module( - "validation", - x = data_handled, - validate_shiny_silent_error = FALSE, - modules = modules + "validation", x = data_handled, validate_shiny_silent_error = FALSE, modules = modules ) data_validated <- .trigger_on_success(data_handled) @@ -178,8 +175,6 @@ srv_teal <- function(id, data, modules, filter = teal_slices()) { }) } - - if (inherits(data, "teal_data_module")) { setBookmarkExclude(c("teal_modules-active_tab")) bslib::nav_insert( @@ -189,10 +184,7 @@ srv_teal <- function(id, data, modules, filter = teal_slices()) { bslib::nav_panel( title = icon("fas fa-database"), value = "teal_data_module", - tags$div( - validate_ui, - ui_init_data(session$ns("data")) - ) + tags$div(validate_ui, ui_init_data(session$ns("data"))) ) ) @@ -232,7 +224,6 @@ srv_teal <- function(id, data, modules, filter = teal_slices()) { invisible(NULL) } - .trigger_on_success <- function(data) { out <- reactiveVal(NULL) observeEvent(data(), { @@ -242,6 +233,5 @@ srv_teal <- function(id, data, modules, filter = teal_slices()) { } } }) - out } diff --git a/R/module_validate.R b/R/module_validate.R index 5ca8727f58..b2e4661cea 100644 --- a/R/module_validate.R +++ b/R/module_validate.R @@ -1,27 +1,23 @@ -#' Factory to build validate modules +#' Factory to build validate module server function #' -#' This function is used to create a module that validates the reactive data -#' passed to it. -#' -#' Dynamically generation of an `ui` and `server` function that can be used -#' internally in teal or in a teal module. +#' Create a module that validates the reactive data. +#' It dynamically generates a `server` function that can be use internally in teal +#' or in a teal module. The `ui` function is generic and common to all modules. #' #' @param module_id (`character(1)`) The module id. #' @param ... (`function`) 1 or more [`shiny::moduleServer()`] functions that +#' @param stop_on_first (`logical(1)`) If `TRUE` (default), only shows the first error. #' return a [`shiny::reactive()`] with `TRUE` or a character string detailing #' the excpetion. #' It can be a named function, a character string or an anonymous function. #' -#' @returns A list with `ui` and `server` functions with code generated from the -#' arguments. -#' +#' @returns A `server` functions with code generated from the function supplied in the arguments. #' @examples -#' #' check_error <- function(x, skip_on_empty_message = TRUE) { #' moduleServer("check_error", function(input, output, session) { #' reactive({ #' if (inherits(x(), "error") && (!skip_on_empty_message || !identical(x()$message, ""))) { -#' c("Error detected", x()$message) +#' tagList(tags$strong("Error detected"), tags$blockquote(x()$message)) #' } else { #' TRUE #' } @@ -31,15 +27,15 @@ #' #' module_validate_factory(check_error) #' -#' check_numeric <- function(x, skip = FALSE) { +#' check_numeric <- function(x) { #' moduleServer("check_numeric", function(input, output, session) { -#' reactive(if (inherits(x(), numeric) || skip) TRUE else "Error: is not numeric") +#' reactive(if (inherits(x(), numeric)) TRUE else "Error: is not numeric") #' }) #' } #' #' module_validate_factory(check_error, check_numeric) #' @keywords internal -module_validate_factory <- function(..., stop_on_first = TRUE) { +srv_module_validate_factory <- function(..., stop_on_first = TRUE) { dots <- rlang::list2(...) checkmate::check_list(dots, min.len = 1) checkmate::assert_flag(stop_on_first) @@ -66,6 +62,7 @@ module_validate_factory <- function(..., stop_on_first = TRUE) { new_server_fun } +#' @rdname module_validate_factory ui_module_validate <- function(id) { div( id = NS(id, "validate_messages"), @@ -259,7 +256,7 @@ srv_module_check_previous_state_warn <- function(x, show_warn = reactive(FALSE), }) } -srv_module_validate_teal_module <- module_validate_factory( # nolint: object_length. +srv_module_validate_teal_module <- srv_module_validate_factory( # nolint: object_length. srv_module_check_previous_state_warn, srv_module_check_shinysilenterror, srv_module_check_validation, @@ -269,7 +266,7 @@ srv_module_validate_teal_module <- module_validate_factory( # nolint: object_len srv_module_check_datanames ) -srv_module_validate_transform <- module_validate_factory( +srv_module_validate_transform <- srv_module_validate_factory( srv_module_check_previous_state_warn, srv_module_check_shinysilenterror, srv_module_check_validation, @@ -278,7 +275,7 @@ srv_module_validate_transform <- module_validate_factory( srv_module_check_teal_data ) -srv_module_validate_datanames <- module_validate_factory( +srv_module_validate_datanames <- srv_module_validate_factory( srv_module_check_previous_state_warn, srv_module_check_datanames ) diff --git a/man/module_validate_factory.Rd b/man/srv_module_validate_factory.Rd similarity index 53% rename from man/module_validate_factory.Rd rename to man/srv_module_validate_factory.Rd index ae4c59b506..45922681ec 100644 --- a/man/module_validate_factory.Rd +++ b/man/srv_module_validate_factory.Rd @@ -1,13 +1,15 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/module_validate.R -\name{module_validate_factory} -\alias{module_validate_factory} -\title{Factory to build validate modules} +\name{srv_module_validate_factory} +\alias{srv_module_validate_factory} +\title{Factory to build validate module server function} \usage{ -module_validate_factory(..., stop_on_first = TRUE) +srv_module_validate_factory(..., stop_on_first = TRUE) } \arguments{ -\item{...}{(\code{function}) 1 or more \code{\link[shiny:moduleServer]{shiny::moduleServer()}} functions that +\item{...}{(\code{function}) 1 or more \code{\link[shiny:moduleServer]{shiny::moduleServer()}} functions that} + +\item{stop_on_first}{(\code{logical(1)}) If \code{TRUE} (default), only shows the first error. return a \code{\link[shiny:reactive]{shiny::reactive()}} with \code{TRUE} or a character string detailing the excpetion. It can be a named function, a character string or an anonymous function.} @@ -15,24 +17,19 @@ It can be a named function, a character string or an anonymous function.} \item{module_id}{(\code{character(1)}) The module id.} } \value{ -A list with \code{ui} and \code{server} functions with code generated from the -arguments. +A \code{server} functions with code generated from the function supplied in the arguments. } \description{ -This function is used to create a module that validates the reactive data -passed to it. -} -\details{ -Dynamically generation of an \code{ui} and \code{server} function that can be used -internally in teal or in a teal module. +Create a module that validates the reactive data. +It dynamically generates a \code{server} function that can be use internally in teal +or in a teal module. The \code{ui} function is generic and common to all modules. } \examples{ - check_error <- function(x, skip_on_empty_message = TRUE) { moduleServer("check_error", function(input, output, session) { reactive({ if (inherits(x(), "error") && (!skip_on_empty_message || !identical(x()$message, ""))) { - c("Error detected", x()$message) + tagList(tags$strong("Error detected"), tags$blockquote(x()$message)) } else { TRUE } @@ -42,9 +39,9 @@ check_error <- function(x, skip_on_empty_message = TRUE) { module_validate_factory(check_error) -check_numeric <- function(x, skip = FALSE) { +check_numeric <- function(x) { moduleServer("check_numeric", function(input, output, session) { - reactive(if (inherits(x(), numeric) || skip) TRUE else "Error: is not numeric") + reactive(if (inherits(x(), numeric)) TRUE else "Error: is not numeric") }) } From 8c2fac1ad0189442fc4edde4c9ee2b4ab42b6022 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 8 Apr 2025 12:06:39 +0100 Subject: [PATCH 37/50] docs: typos --- R/module_validate.R | 10 ++++------ man/srv_module_validate_factory.Rd | 11 ++++++----- 2 files changed, 10 insertions(+), 11 deletions(-) diff --git a/R/module_validate.R b/R/module_validate.R index b2e4661cea..db68e061f0 100644 --- a/R/module_validate.R +++ b/R/module_validate.R @@ -24,16 +24,14 @@ #' }) #' }) #' } -#' -#' module_validate_factory(check_error) +#' srv_module_validate_factory(check_error) #' #' check_numeric <- function(x) { #' moduleServer("check_numeric", function(input, output, session) { -#' reactive(if (inherits(x(), numeric)) TRUE else "Error: is not numeric") +#' reactive(checkmate::check_numeric(x())) #' }) #' } -#' -#' module_validate_factory(check_error, check_numeric) +#' srv_module_validate_factory(check_error, check_numeric) #' @keywords internal srv_module_validate_factory <- function(..., stop_on_first = TRUE) { dots <- rlang::list2(...) @@ -62,7 +60,7 @@ srv_module_validate_factory <- function(..., stop_on_first = TRUE) { new_server_fun } -#' @rdname module_validate_factory +#' @rdname srv_module_validate_factory ui_module_validate <- function(id) { div( id = NS(id, "validate_messages"), diff --git a/man/srv_module_validate_factory.Rd b/man/srv_module_validate_factory.Rd index 45922681ec..bc9ae5a0cf 100644 --- a/man/srv_module_validate_factory.Rd +++ b/man/srv_module_validate_factory.Rd @@ -2,9 +2,12 @@ % Please edit documentation in R/module_validate.R \name{srv_module_validate_factory} \alias{srv_module_validate_factory} +\alias{ui_module_validate} \title{Factory to build validate module server function} \usage{ srv_module_validate_factory(..., stop_on_first = TRUE) + +ui_module_validate(id) } \arguments{ \item{...}{(\code{function}) 1 or more \code{\link[shiny:moduleServer]{shiny::moduleServer()}} functions that} @@ -36,15 +39,13 @@ check_error <- function(x, skip_on_empty_message = TRUE) { }) }) } - -module_validate_factory(check_error) +srv_module_validate_factory(check_error) check_numeric <- function(x) { moduleServer("check_numeric", function(input, output, session) { - reactive(if (inherits(x(), numeric)) TRUE else "Error: is not numeric") + reactive(checkmate::check_numeric(x())) }) } - -module_validate_factory(check_error, check_numeric) +srv_module_validate_factory(check_error, check_numeric) } \keyword{internal} From ac5c67a165276f37d8a38123593eaf749ed62c0e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 8 Apr 2025 12:11:50 +0100 Subject: [PATCH 38/50] docs: out of order --- R/module_validate.R | 19 +++++++------------ man/srv_module_validate_factory.Rd | 19 ++++++++----------- 2 files changed, 15 insertions(+), 23 deletions(-) diff --git a/R/module_validate.R b/R/module_validate.R index db68e061f0..12af0eea7e 100644 --- a/R/module_validate.R +++ b/R/module_validate.R @@ -4,14 +4,12 @@ #' It dynamically generates a `server` function that can be use internally in teal #' or in a teal module. The `ui` function is generic and common to all modules. #' -#' @param module_id (`character(1)`) The module id. #' @param ... (`function`) 1 or more [`shiny::moduleServer()`] functions that -#' @param stop_on_first (`logical(1)`) If `TRUE` (default), only shows the first error. -#' return a [`shiny::reactive()`] with `TRUE` or a character string detailing -#' the excpetion. +#' return a [`shiny::reactive()`] with `TRUE` or a character string detailing the exception. #' It can be a named function, a character string or an anonymous function. +#' @param stop_on_first (`logical(1)`) If `TRUE` (default), only shows the first error. #' -#' @returns A `server` functions with code generated from the function supplied in the arguments. +#' @returns A `server` function with code generated from the function supplied in the arguments. #' @examples #' check_error <- function(x, skip_on_empty_message = TRUE) { #' moduleServer("check_error", function(input, output, session) { @@ -26,10 +24,10 @@ #' } #' srv_module_validate_factory(check_error) #' -#' check_numeric <- function(x) { -#' moduleServer("check_numeric", function(input, output, session) { -#' reactive(checkmate::check_numeric(x())) -#' }) +#' check_numeric <- function(x, null.ok = FALSE) { +#' moduleServer("check_numeric", function(input, output, session) +#' reactive(checkmate::check_numeric(x(), null.ok = null.ok)) +#' ) #' } #' srv_module_validate_factory(check_error, check_numeric) #' @keywords internal @@ -51,9 +49,6 @@ srv_module_validate_factory <- function(..., stop_on_first = TRUE) { new_server_fun <- function(id) TRUE # Empty server template server_formals <- .join_formals(formals(new_server_fun), dots) - if (stop_on_first) { - server_formals <- c(server_formals, pairlist(stop_on_first = stop_on_first)) - } server_body <- .validate_module_server(check_calls, stop_on_first = stop_on_first) formals(new_server_fun) <- server_formals # update function formals body(new_server_fun) <- server_body # set the new generated body diff --git a/man/srv_module_validate_factory.Rd b/man/srv_module_validate_factory.Rd index bc9ae5a0cf..4b7776ba16 100644 --- a/man/srv_module_validate_factory.Rd +++ b/man/srv_module_validate_factory.Rd @@ -10,17 +10,14 @@ srv_module_validate_factory(..., stop_on_first = TRUE) ui_module_validate(id) } \arguments{ -\item{...}{(\code{function}) 1 or more \code{\link[shiny:moduleServer]{shiny::moduleServer()}} functions that} - -\item{stop_on_first}{(\code{logical(1)}) If \code{TRUE} (default), only shows the first error. -return a \code{\link[shiny:reactive]{shiny::reactive()}} with \code{TRUE} or a character string detailing -the excpetion. +\item{...}{(\code{function}) 1 or more \code{\link[shiny:moduleServer]{shiny::moduleServer()}} functions that +return a \code{\link[shiny:reactive]{shiny::reactive()}} with \code{TRUE} or a character string detailing the exception. It can be a named function, a character string or an anonymous function.} -\item{module_id}{(\code{character(1)}) The module id.} +\item{stop_on_first}{(\code{logical(1)}) If \code{TRUE} (default), only shows the first error.} } \value{ -A \code{server} functions with code generated from the function supplied in the arguments. +A \code{server} function with code generated from the function supplied in the arguments. } \description{ Create a module that validates the reactive data. @@ -41,10 +38,10 @@ check_error <- function(x, skip_on_empty_message = TRUE) { } srv_module_validate_factory(check_error) -check_numeric <- function(x) { - moduleServer("check_numeric", function(input, output, session) { - reactive(checkmate::check_numeric(x())) - }) +check_numeric <- function(x, null.ok = FALSE) { + moduleServer("check_numeric", function(input, output, session) + reactive(checkmate::check_numeric(x(), null.ok = null.ok)) + ) } srv_module_validate_factory(check_error, check_numeric) } From 47dd8eb7b64c9afe0037bc0ac6c94a7661924ddc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 8 Apr 2025 12:52:38 +0100 Subject: [PATCH 39/50] feat: support for in-module validation --- R/module_validate.R | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/R/module_validate.R b/R/module_validate.R index 12af0eea7e..d15642e2be 100644 --- a/R/module_validate.R +++ b/R/module_validate.R @@ -72,7 +72,9 @@ ui_module_validate <- function(id) { quote(isTRUE(v()) || is.null(v())) module_server_body <- bquote({ # Template moduleServer that supports multiple checks checkmate::assert_string(id) # Mandatory id parameter + top_level_x <- x moduleServer(id, function(input, output, session) { + x <- reactive(tryCatch(top_level_x(), error = function(e) e)) collection <- list() ..(check_calls) # Generates expressions: "collection <- append(collection, srv_module_check_xxxx(x))" @@ -163,7 +165,7 @@ srv_module_check_validation <- function(x) { reactive({ if (checkmate::test_class(x(), c("shiny.silent.error", "validation")) && !identical(x()$message, "")) { tagList( - tags$span("Shiny validation error was raised:"), + tags$span("Validation error:"), tags$blockquote(tags$em(x()$message)) ) } else { @@ -272,3 +274,7 @@ srv_module_validate_datanames <- srv_module_validate_factory( srv_module_check_previous_state_warn, srv_module_check_datanames ) + +srv_module_validate_validation <- srv_module_validate_factory( + srv_module_check_validation +) From ed10c4d605e2952117ae4bc330081222ff46df14 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 8 Apr 2025 14:13:06 +0100 Subject: [PATCH 40/50] fix: decorated behavior --- R/module_transform_data.R | 8 +++----- inst/css/validation.css | 2 +- 2 files changed, 4 insertions(+), 6 deletions(-) diff --git a/R/module_transform_data.R b/R/module_transform_data.R index 473ebbca89..1c4ae28dce 100644 --- a/R/module_transform_data.R +++ b/R/module_transform_data.R @@ -80,12 +80,12 @@ srv_transform_teal_data <- function(id, data, transformators, modules = NULL, is function(data_previous, name) { moduleServer(name, function(input, output, session) { logger::log_debug("srv_transform_teal_data@1 initializing module for { name }.") - data_out <- reactiveVal() .call_once_when(inherits(data_previous(), "teal_data"), { logger::log_debug("srv_teal_transform_teal_data@2 triggering a transform module call for { name }.") data_unhandled <- transformators[[name]]$server("transform", data = data_previous) data_handled <- reactive(tryCatch(data_unhandled(), error = function(e) e)) + data_previous_handled <- reactive(tryCatch(data_previous(), error = function(e) e)) observeEvent(data_handled(), { if (inherits(data_handled(), "teal_data")) { @@ -97,7 +97,7 @@ srv_transform_teal_data <- function(id, data, transformators, modules = NULL, is is_transform_failed[[name]] <- FALSE observeEvent(data_handled(), { - if (inherits(data_handled(), "teal_data")) { + if (inherits(data_handled(), "teal_data") || rlang::is_condition(data_previous_handled())) { is_transform_failed[[name]] <- FALSE } else { is_transform_failed[[name]] <- TRUE @@ -132,9 +132,7 @@ srv_transform_teal_data <- function(id, data, transformators, modules = NULL, is }) # Ignoring unwanted reactivity breaks during initialization - reactive({ - req(data_out()) - }) + reactive(req(data_out())) }) }, x = names(transformators), diff --git a/inst/css/validation.css b/inst/css/validation.css index 09f6e2ac8c..abd1d6ebdd 100644 --- a/inst/css/validation.css +++ b/inst/css/validation.css @@ -1,4 +1,4 @@ -.teal_validated { padding: 1em; } +.teal_validated:has(.shiny-output-error, .teal-output-warning) { padding: 1em; } .sidebar .teal_validated { padding: 0.2em; } .teal_validated:has(.shiny-output-error), From f2341d1522531760dc1c6d3b2ca05e6d7cc56145 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 8 Apr 2025 16:20:59 +0100 Subject: [PATCH 41/50] fix: tentative solution for decorated failed original data --- R/module_transform_data.R | 25 ++++++++++++++++++++----- 1 file changed, 20 insertions(+), 5 deletions(-) diff --git a/R/module_transform_data.R b/R/module_transform_data.R index 1c4ae28dce..0484aec39c 100644 --- a/R/module_transform_data.R +++ b/R/module_transform_data.R @@ -81,14 +81,26 @@ srv_transform_teal_data <- function(id, data, transformators, modules = NULL, is moduleServer(name, function(input, output, session) { logger::log_debug("srv_transform_teal_data@1 initializing module for { name }.") data_out <- reactiveVal() + .call_once_when(inherits(data_previous(), "teal_data"), { logger::log_debug("srv_teal_transform_teal_data@2 triggering a transform module call for { name }.") data_unhandled <- transformators[[name]]$server("transform", data = data_previous) data_handled <- reactive(tryCatch(data_unhandled(), error = function(e) e)) - data_previous_handled <- reactive(tryCatch(data_previous(), error = function(e) e)) + data_original_handled <- reactive(tryCatch(data(), error = function(e) e)) - observeEvent(data_handled(), { - if (inherits(data_handled(), "teal_data")) { + observeEvent({ + data_handled() + data_original_handled() + }, { + if (rlang::is_condition(data_original_handled())) { + data_out( + within( + teal.code::qenv(), + stop("Error with original data: ", message), + message = data_original_handled()$message + ) + ) + } else if (inherits(data_handled(), "teal_data")) { if (!identical(data_handled(), data_out())) { data_out(data_handled()) } @@ -97,7 +109,7 @@ srv_transform_teal_data <- function(id, data, transformators, modules = NULL, is is_transform_failed[[name]] <- FALSE observeEvent(data_handled(), { - if (inherits(data_handled(), "teal_data") || rlang::is_condition(data_previous_handled())) { + if (inherits(data_handled(), "teal_data") || rlang::is_condition(data_original_handled())) { is_transform_failed[[name]] <- FALSE } else { is_transform_failed[[name]] <- TRUE @@ -132,7 +144,10 @@ srv_transform_teal_data <- function(id, data, transformators, modules = NULL, is }) # Ignoring unwanted reactivity breaks during initialization - reactive(req(data_out())) + reactive({ + print("data_out()") + req(data_out()) + }) }) }, x = names(transformators), From a3b3afd3012255e9ec91656221bbaca5528f550a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 8 Apr 2025 17:06:18 +0100 Subject: [PATCH 42/50] feat: disable transforms/decorators and show info message when top-level data is not teal_data --- R/module_transform_data.R | 20 ++++++++++++++------ R/module_validate.R | 5 +++-- inst/css/validation.css | 25 ++++++++++++++++++++++++- 3 files changed, 41 insertions(+), 9 deletions(-) diff --git a/R/module_transform_data.R b/R/module_transform_data.R index 0484aec39c..f9f7976369 100644 --- a/R/module_transform_data.R +++ b/R/module_transform_data.R @@ -46,6 +46,12 @@ ui_transform_teal_data <- function(id, transformators, class = "well") { bslib::accordion_panel( attr(data_mod, "label", exact = TRUE), icon = bsicons::bs_icon("palette-fill"), + tags$div( + class = "disabled-info", + title = "Disabled until data becomes valid", + bsicons::bs_icon("info-circle"), + "Disabled until data becomes valid" + ), tags$div( id = ns(sprintf("wrapper_%s", name)), ui_module_validate(ns("validation")), @@ -76,23 +82,28 @@ srv_transform_teal_data <- function(id, data, transformators, modules = NULL, is names(transformators) <- sprintf("transform_%d", seq_len(length(transformators))) moduleServer(id, function(input, output, session) { + data_original_handled <- reactive(tryCatch(data(), error = function(e) e)) module_output <- Reduce( function(data_previous, name) { moduleServer(name, function(input, output, session) { logger::log_debug("srv_transform_teal_data@1 initializing module for { name }.") data_out <- reactiveVal() + # Disable all elements if original data is not yet a teal_data + observeEvent(data_original_handled(), { + (if (!inherits(data_original_handled(), "teal_data")) shinyjs::disable else shinyjs::enable)("wrapper") + }) + .call_once_when(inherits(data_previous(), "teal_data"), { logger::log_debug("srv_teal_transform_teal_data@2 triggering a transform module call for { name }.") data_unhandled <- transformators[[name]]$server("transform", data = data_previous) data_handled <- reactive(tryCatch(data_unhandled(), error = function(e) e)) - data_original_handled <- reactive(tryCatch(data(), error = function(e) e)) observeEvent({ data_handled() data_original_handled() }, { - if (rlang::is_condition(data_original_handled())) { + if (!inherits(data_original_handled(), "teal_data")) { data_out( within( teal.code::qenv(), @@ -144,10 +155,7 @@ srv_transform_teal_data <- function(id, data, transformators, modules = NULL, is }) # Ignoring unwanted reactivity breaks during initialization - reactive({ - print("data_out()") - req(data_out()) - }) + reactive(req(data_out())) }) }, x = names(transformators), diff --git a/R/module_validate.R b/R/module_validate.R index d15642e2be..e52b99ca9c 100644 --- a/R/module_validate.R +++ b/R/module_validate.R @@ -225,6 +225,7 @@ srv_module_check_condition <- function(x) { moduleServer("check_error", function(input, output, session) { reactive({ # shiny.silent.errors are handled in a different module if (inherits(x(), "error") && !inherits(x(), "shiny.silent.error")) { + browser() tagList( tags$span("Error detected:"), tags$blockquote(tags$em(trimws(x()$message))) @@ -265,9 +266,9 @@ srv_module_validate_transform <- srv_module_validate_factory( srv_module_check_previous_state_warn, srv_module_check_shinysilenterror, srv_module_check_validation, - srv_module_check_condition, srv_module_check_reactive, - srv_module_check_teal_data + srv_module_check_teal_data, + srv_module_check_condition ) srv_module_validate_datanames <- srv_module_validate_factory( diff --git a/inst/css/validation.css b/inst/css/validation.css index abd1d6ebdd..624d6f9904 100644 --- a/inst/css/validation.css +++ b/inst/css/validation.css @@ -1,9 +1,32 @@ .teal_validated:has(.shiny-output-error, .teal-output-warning) { padding: 1em; } .sidebar .teal_validated { padding: 0.2em; } +.validation-wrapper { + --bs-accordion-body-padding-y: 0 1rem; +} + +.validation-wrapper[disabled="disabled"] { + --bs-accordion-bg: var(--bs-gray-100); + background-color: var(--bs-gray-100); +} + +.validation-wrapper[disabled="disabled"]:has(.shiny-output-error, .teal-output-warning) .disabled-info, +.validation-wrapper .disabled-info { + display: none; +} + +.validation-wrapper[disabled="disabled"] .disabled-info { + display: block; + border-color: var(--bs-info); + padding: 1em; + color: color-mix(in srgb, var(--bs-info), black 20%); + background-color: color-mix(in srgb, var(--bs-info) 5%, transparent); +} + .teal_validated:has(.shiny-output-error), .teal_validated:has(.teal-output-warning), -.teal_validated:has(.teal-output-warning-previous) { +.teal_validated:has(.teal-output-warning-previous), +.validation-wrapper .disabled-info{ border: solid 1px transparent; border-radius: 4px; } From 8ac867e59cd91b449b3726115b543679eae42e25 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Wed, 9 Apr 2025 17:45:33 +0100 Subject: [PATCH 43/50] chore: improve message --- R/module_transform_data.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/module_transform_data.R b/R/module_transform_data.R index f9f7976369..6bd2ff99bf 100644 --- a/R/module_transform_data.R +++ b/R/module_transform_data.R @@ -50,7 +50,7 @@ ui_transform_teal_data <- function(id, transformators, class = "well") { class = "disabled-info", title = "Disabled until data becomes valid", bsicons::bs_icon("info-circle"), - "Disabled until data becomes valid" + "Disabled until data becomes valid. Check your inputs." ), tags$div( id = ns(sprintf("wrapper_%s", name)), From 5fbb21532d14ff68134b2a83f7823fc05cd16d65 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Mon, 21 Apr 2025 12:28:51 +0100 Subject: [PATCH 44/50] fix: remove browser --- R/module_validate.R | 57 ++++++++++++++++-------------- man/srv_module_validate_factory.Rd | 4 +-- 2 files changed, 32 insertions(+), 29 deletions(-) diff --git a/R/module_validate.R b/R/module_validate.R index e52b99ca9c..700a6e450f 100644 --- a/R/module_validate.R +++ b/R/module_validate.R @@ -25,9 +25,9 @@ #' srv_module_validate_factory(check_error) #' #' check_numeric <- function(x, null.ok = FALSE) { -#' moduleServer("check_numeric", function(input, output, session) +#' moduleServer("check_numeric", function(input, output, session) { #' reactive(checkmate::check_numeric(x(), null.ok = null.ok)) -#' ) +#' }) #' } #' srv_module_validate_factory(check_error, check_numeric) #' @keywords internal @@ -66,35 +66,39 @@ ui_module_validate <- function(id) { #' @keywords internal .validate_module_server <- function(check_calls, stop_on_first) { - condition <- if (stop_on_first) + condition <- if (stop_on_first) { quote(length(u) > 0 || isTRUE(v()) || is.null(v())) - else + } else { quote(isTRUE(v()) || is.null(v())) - module_server_body <- bquote({ # Template moduleServer that supports multiple checks - checkmate::assert_string(id) # Mandatory id parameter - top_level_x <- x - moduleServer(id, function(input, output, session) { - x <- reactive(tryCatch(top_level_x(), error = function(e) e)) - collection <- list() - ..(check_calls) # Generates expressions: "collection <- append(collection, srv_module_check_xxxx(x))" + } + module_server_body <- bquote( + { # Template moduleServer that supports multiple checks + checkmate::assert_string(id) # Mandatory id parameter + top_level_x <- x + moduleServer(id, function(input, output, session) { + x <- reactive(tryCatch(top_level_x(), error = function(e) e)) + collection <- list() + ..(check_calls) # Generates expressions: "collection <- append(collection, srv_module_check_xxxx(x))" - fun <- function(u, v) if (.(condition)) u else append(u, list(v())) - validate_r <- reactive(Reduce(fun, x = collection, init = list())) - has_errors <- reactiveVal(TRUE) + fun <- function(u, v) if (.(condition)) u else append(u, list(v())) + validate_r <- reactive(Reduce(fun, x = collection, init = list())) + has_errors <- reactiveVal(TRUE) - output$errors <- renderUI({ - error_class <- c("shiny.silent.error", "validation", "error", "condition") - if (length(validate_r()) > 0) { - has_errors(FALSE) - tagList(!!!lapply(validate_r(), .render_output_condition)) - } else { - has_errors(TRUE) - NULL - } + output$errors <- renderUI({ + error_class <- c("shiny.silent.error", "validation", "error", "condition") + if (length(validate_r()) > 0) { + has_errors(FALSE) + tagList(!!!lapply(validate_r(), .render_output_condition)) + } else { + has_errors(TRUE) + NULL + } + }) + has_errors }) - has_errors - }) - }, splice = TRUE) + }, + splice = TRUE + ) } #' @keywords internal @@ -225,7 +229,6 @@ srv_module_check_condition <- function(x) { moduleServer("check_error", function(input, output, session) { reactive({ # shiny.silent.errors are handled in a different module if (inherits(x(), "error") && !inherits(x(), "shiny.silent.error")) { - browser() tagList( tags$span("Error detected:"), tags$blockquote(tags$em(trimws(x()$message))) diff --git a/man/srv_module_validate_factory.Rd b/man/srv_module_validate_factory.Rd index 4b7776ba16..495a958455 100644 --- a/man/srv_module_validate_factory.Rd +++ b/man/srv_module_validate_factory.Rd @@ -39,9 +39,9 @@ check_error <- function(x, skip_on_empty_message = TRUE) { srv_module_validate_factory(check_error) check_numeric <- function(x, null.ok = FALSE) { - moduleServer("check_numeric", function(input, output, session) + moduleServer("check_numeric", function(input, output, session) { reactive(checkmate::check_numeric(x(), null.ok = null.ok)) - ) + }) } srv_module_validate_factory(check_error, check_numeric) } From 6f5fe2579e811d7cd8532c40d625e5eb60a320de Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Wed, 7 May 2025 13:55:39 +0100 Subject: [PATCH 45/50] fix: blurred UI --- R/module_nested_tabs.R | 4 +++- inst/css/custom.css | 4 ++++ 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/R/module_nested_tabs.R b/R/module_nested_tabs.R index 63c1f85c91..d2183e9a74 100644 --- a/R/module_nested_tabs.R +++ b/R/module_nested_tabs.R @@ -351,7 +351,9 @@ srv_teal_module.teal_module <- function(id, ) observe({ # Hide main module UI when there are errors with reactive teal_data - (if (any_transform_failed()) shinyjs::hide else shinyjs::show)("teal_module_ui") + shinyjs::show("teal_module_ui") + shinyjs::toggleClass("teal_module_ui", "blurred", condition = any_transform_failed()) + shinyjs::toggleState("teal_module_ui", condition = any_transform_failed()) }) summary_table <- srv_data_summary("data_summary", module_teal_data) diff --git a/inst/css/custom.css b/inst/css/custom.css index 357b2aa7b8..0841e6965f 100644 --- a/inst/css/custom.css +++ b/inst/css/custom.css @@ -16,6 +16,10 @@ body > div:has(~ #shiny-modal-wrapper .blur_background) { filter: blur(5px); } +.blurred { + filter: blur(5px); +} + #shiny-modal.fade.in:has(.hide_background) { transition: background-color 0.3s; } From f52de2b23ab2fb9205ebd83f55b04e6f04d06197 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Wed, 7 May 2025 14:05:12 +0100 Subject: [PATCH 46/50] style: border on accordion with error messages --- inst/css/custom.css | 4 ---- inst/css/validation.css | 6 ++++++ 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/inst/css/custom.css b/inst/css/custom.css index 0841e6965f..357b2aa7b8 100644 --- a/inst/css/custom.css +++ b/inst/css/custom.css @@ -16,10 +16,6 @@ body > div:has(~ #shiny-modal-wrapper .blur_background) { filter: blur(5px); } -.blurred { - filter: blur(5px); -} - #shiny-modal.fade.in:has(.hide_background) { transition: background-color 0.3s; } diff --git a/inst/css/validation.css b/inst/css/validation.css index 624d6f9904..ef792c47e6 100644 --- a/inst/css/validation.css +++ b/inst/css/validation.css @@ -102,3 +102,9 @@ } .teal_validated.previous-failed .teal-output-warning-previous { display: flex; } + +.blurred { filter: blur(5px); } +.validation-wrapper:has(.shiny-output-error) { + border: 3px solid var(--bs-danger); + border-radius: var(--bs-accordion-border-radius); +} From 62b53ad48b7b26e8d4508a79993993432000419d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Wed, 7 May 2025 14:25:17 +0100 Subject: [PATCH 47/50] fix: condition --- R/module_validate.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/module_validate.R b/R/module_validate.R index 700a6e450f..813071a2f0 100644 --- a/R/module_validate.R +++ b/R/module_validate.R @@ -111,7 +111,7 @@ ui_module_validate <- function(id) { ifelse(is_warning, "teal-output-warning", "shiny-output-error") ) - if (!checkmate::test_character(cond)) { + if (checkmate::test_character(cond)) { html_class <- c(html_class, "prewrap-ws") cond <- lapply(cond, tags$p) } From 308e80a0934f233cfb5bbbe201b7749b04c0e4ec Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Wed, 7 May 2025 14:27:31 +0100 Subject: [PATCH 48/50] fix: condition --- R/module_nested_tabs.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/module_nested_tabs.R b/R/module_nested_tabs.R index d2183e9a74..3433736aec 100644 --- a/R/module_nested_tabs.R +++ b/R/module_nested_tabs.R @@ -353,7 +353,7 @@ srv_teal_module.teal_module <- function(id, observe({ # Hide main module UI when there are errors with reactive teal_data shinyjs::show("teal_module_ui") shinyjs::toggleClass("teal_module_ui", "blurred", condition = any_transform_failed()) - shinyjs::toggleState("teal_module_ui", condition = any_transform_failed()) + shinyjs::toggleState("teal_module_ui", condition = !any_transform_failed()) }) summary_table <- srv_data_summary("data_summary", module_teal_data) From 8d86b105db194a412e05ae1a391f85438a18bc86 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Wed, 7 May 2025 14:41:19 +0100 Subject: [PATCH 49/50] fix: issues with disabling accordions --- R/module_nested_tabs.R | 2 +- R/module_transform_data.R | 40 ++++++++++++++++++++++----------------- 2 files changed, 24 insertions(+), 18 deletions(-) diff --git a/R/module_nested_tabs.R b/R/module_nested_tabs.R index 3433736aec..539391856d 100644 --- a/R/module_nested_tabs.R +++ b/R/module_nested_tabs.R @@ -350,7 +350,7 @@ srv_teal_module.teal_module <- function(id, message_warn = "One of the transformators failed. Please check its inputs." ) - observe({ # Hide main module UI when there are errors with reactive teal_data + observe({ # Blur and disable main module UI when there are errors with reactive teal_data shinyjs::show("teal_module_ui") shinyjs::toggleClass("teal_module_ui", "blurred", condition = any_transform_failed()) shinyjs::toggleState("teal_module_ui", condition = !any_transform_failed()) diff --git a/R/module_transform_data.R b/R/module_transform_data.R index 6bd2ff99bf..13ecd6007c 100644 --- a/R/module_transform_data.R +++ b/R/module_transform_data.R @@ -91,7 +91,10 @@ srv_transform_teal_data <- function(id, data, transformators, modules = NULL, is # Disable all elements if original data is not yet a teal_data observeEvent(data_original_handled(), { - (if (!inherits(data_original_handled(), "teal_data")) shinyjs::disable else shinyjs::enable)("wrapper") + shinyjs::toggleState( + sprintf("wrapper_%s", name), + condition = inherits(data_original_handled(), "teal_data") + ) }) .call_once_when(inherits(data_previous(), "teal_data"), { @@ -99,24 +102,27 @@ srv_transform_teal_data <- function(id, data, transformators, modules = NULL, is data_unhandled <- transformators[[name]]$server("transform", data = data_previous) data_handled <- reactive(tryCatch(data_unhandled(), error = function(e) e)) - observeEvent({ - data_handled() - data_original_handled() - }, { - if (!inherits(data_original_handled(), "teal_data")) { - data_out( - within( - teal.code::qenv(), - stop("Error with original data: ", message), - message = data_original_handled()$message + observeEvent( + { + data_handled() + data_original_handled() + }, + { + if (!inherits(data_original_handled(), "teal_data")) { + data_out( + within( + teal.code::qenv(), + stop("Error with original data: ", message), + message = data_original_handled()$message + ) ) - ) - } else if (inherits(data_handled(), "teal_data")) { - if (!identical(data_handled(), data_out())) { - data_out(data_handled()) + } else if (inherits(data_handled(), "teal_data")) { + if (!identical(data_handled(), data_out())) { + data_out(data_handled()) + } } } - }) + ) is_transform_failed[[name]] <- FALSE observeEvent(data_handled(), { @@ -150,7 +156,7 @@ srv_transform_teal_data <- function(id, data, transformators, modules = NULL, is }) # Disable the UI elements in case of previous error observe({ - (if (is_previous_failed()) shinyjs::disable else shinyjs::enable)("wrapper") + shinyjs::toggleState(sprintf("wrapper_%s", name), condition = !is_previous_failed()) }) }) From 640a890d4d6be59e3fff7123f9d7952347287396 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Thu, 8 May 2025 18:45:43 +0100 Subject: [PATCH 50/50] revert: changes moved to #1515 --- R/module_transform_data.R | 35 ++++++----------------------------- 1 file changed, 6 insertions(+), 29 deletions(-) diff --git a/R/module_transform_data.R b/R/module_transform_data.R index 13ecd6007c..63f36c26b7 100644 --- a/R/module_transform_data.R +++ b/R/module_transform_data.R @@ -82,51 +82,28 @@ srv_transform_teal_data <- function(id, data, transformators, modules = NULL, is names(transformators) <- sprintf("transform_%d", seq_len(length(transformators))) moduleServer(id, function(input, output, session) { - data_original_handled <- reactive(tryCatch(data(), error = function(e) e)) module_output <- Reduce( function(data_previous, name) { moduleServer(name, function(input, output, session) { logger::log_debug("srv_transform_teal_data@1 initializing module for { name }.") data_out <- reactiveVal() - # Disable all elements if original data is not yet a teal_data - observeEvent(data_original_handled(), { - shinyjs::toggleState( - sprintf("wrapper_%s", name), - condition = inherits(data_original_handled(), "teal_data") - ) - }) - .call_once_when(inherits(data_previous(), "teal_data"), { logger::log_debug("srv_teal_transform_teal_data@2 triggering a transform module call for { name }.") data_unhandled <- transformators[[name]]$server("transform", data = data_previous) data_handled <- reactive(tryCatch(data_unhandled(), error = function(e) e)) - observeEvent( - { - data_handled() - data_original_handled() - }, - { - if (!inherits(data_original_handled(), "teal_data")) { - data_out( - within( - teal.code::qenv(), - stop("Error with original data: ", message), - message = data_original_handled()$message - ) - ) - } else if (inherits(data_handled(), "teal_data")) { - if (!identical(data_handled(), data_out())) { - data_out(data_handled()) - } + observeEvent(data_handled(), { + if (inherits(data_handled(), "teal_data")) { + if (!identical(data_handled(), data_out())) { + data_out(data_handled()) } } - ) + }) is_transform_failed[[name]] <- FALSE observeEvent(data_handled(), { - if (inherits(data_handled(), "teal_data") || rlang::is_condition(data_original_handled())) { + if (inherits(data_handled(), "teal_data")) { is_transform_failed[[name]] <- FALSE } else { is_transform_failed[[name]] <- TRUE