From c154c7c9dbc690a38a721e6bedb4a2d8681cbf4e Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Mon, 2 Jan 2023 17:14:51 +0100 Subject: [PATCH 01/14] add check on enabled status --- R/validate_inputs.R | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/R/validate_inputs.R b/R/validate_inputs.R index d1a4469db7..c7028bd019 100644 --- a/R/validate_inputs.R +++ b/R/validate_inputs.R @@ -108,6 +108,11 @@ validate_inputs <- function(..., header = "Some inputs require attention") { lapply(vals, checkmate::assert_class, "InputValidator") checkmate::assert_string(header, null.ok = TRUE) + if (any(vapply(vals, function(iv) isFALSE(iv$.__enclos_env__$private$enabled), logical(1L)))) { + warning("Some validators are disabled and will be omitted.", call. = TRUE) + } + vals <- Filter(function(iv) iv$.__enclos_env__$private$enabled, vals) + fail_messages <- unlist(lapply(vals, gather_messages)) failings <- add_header(fail_messages, header) @@ -120,6 +125,11 @@ validate_inputs <- function(..., header = "Some inputs require attention") { validate_inputs_segregated <- function(validators, ...) { checkmate::assert_list(validators, types = "InputValidator") + if (any(vapply(validators, function(iv) isFALSE(iv$.__enclos_env__$private$enabled), logical(1L)))) { + warning("Some validators are disabled and will be omitted.", call. = TRUE) + } + validators <- Filter(function(iv) iv$.__enclos_env__$private$enabled, validators) + # Since some or all names may be NULL, mapply cannot be used here, a loop is required. fail_messages <- vector("list", length(validators)) for (v in seq_along(validators)) { From 3001afc0525db8c2cae13ed871ffacd507c67922 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Tue, 3 Jan 2023 13:08:08 +0100 Subject: [PATCH 02/14] apply code review --- R/validate_inputs.R | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/R/validate_inputs.R b/R/validate_inputs.R index c7028bd019..ab34202457 100644 --- a/R/validate_inputs.R +++ b/R/validate_inputs.R @@ -108,10 +108,10 @@ validate_inputs <- function(..., header = "Some inputs require attention") { lapply(vals, checkmate::assert_class, "InputValidator") checkmate::assert_string(header, null.ok = TRUE) - if (any(vapply(vals, function(iv) isFALSE(iv$.__enclos_env__$private$enabled), logical(1L)))) { + if (!all(vapply(vals, validator_enabled, logical(1L)))) { warning("Some validators are disabled and will be omitted.", call. = TRUE) } - vals <- Filter(function(iv) iv$.__enclos_env__$private$enabled, vals) + vals <- Filter(validator_enabled, vals) fail_messages <- unlist(lapply(vals, gather_messages)) failings <- add_header(fail_messages, header) @@ -125,10 +125,10 @@ validate_inputs <- function(..., header = "Some inputs require attention") { validate_inputs_segregated <- function(validators, ...) { checkmate::assert_list(validators, types = "InputValidator") - if (any(vapply(validators, function(iv) isFALSE(iv$.__enclos_env__$private$enabled), logical(1L)))) { + if (!all(vapply(validators, validator_enabled, logical(1L)))) { warning("Some validators are disabled and will be omitted.", call. = TRUE) } - validators <- Filter(function(iv) iv$.__enclos_env__$private$enabled, validators) + validators <- Filter(validator_enabled, validators) # Since some or all names may be NULL, mapply cannot be used here, a loop is required. fail_messages <- vector("list", length(validators)) @@ -152,7 +152,6 @@ gather_messages <- function(iv) { unique(lapply(failing_inputs, function(x) x[["message"]])) } - #' @keywords internal # format failing messages with optional header message add_header <- function(messages, header) { @@ -171,3 +170,10 @@ gather_and_add <- function(iv, header) { failings <- add_header(fail_messages, header) failings } + +#' @keywords internal +#' test if an InputValidator object is enabled +#' returns logical of length 1 +validator_enabled <- function(x) { + x$.__enclos_env__$private$enabled +} From 69cafc18817e899994664387e44ed3f511b7ba28 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Tue, 3 Jan 2023 13:20:25 +0100 Subject: [PATCH 03/14] add unit tests --- tests/testthat/test-validate_inputs.R | 42 +++++++++++++++++++++++++++ 1 file changed, 42 insertions(+) diff --git a/tests/testthat/test-validate_inputs.R b/tests/testthat/test-validate_inputs.R index c555e47dcd..e6a75a1b37 100644 --- a/tests/testthat/test-validate_inputs.R +++ b/tests/testthat/test-validate_inputs.R @@ -5,6 +5,48 @@ testthat::test_that("invalid arguments raise errors", { }) +testthat::test_that("validate_inputs: disabled validators raise warnings", { + server <- function(input, output, session) { + iv <- shinyvalidate::InputValidator$new() + iv$add_rule("letter", shinyvalidate::sv_in_set(LETTERS, "choose a capital letter")) + iv$add_rule("number", ~ if (as.integer(.) %% 2L == 1L) "choose an even number") + values <- shiny::reactive({ + validate_inputs(iv) + list( + "letter" = input[["letter"]], + "number" = input[["number"]] + ) + }) + } + + shiny::testServer(server, { + testthat::expect_warning(values()) + }) +}) + + +testthat::test_that("validate_inputs_segregated: disabled validators raise warnings", { + server <- function(input, output, session) { + iv1 <- shinyvalidate::InputValidator$new() + iv1$add_rule("letter", shinyvalidate::sv_in_set(LETTERS, "choose a capital letter")) + iv1$enable() + iv2 <- shinyvalidate::InputValidator$new() + iv2$add_rule("number", ~ if (as.integer(.) %% 2L == 1L) "choose an even number") + values <- shiny::reactive({ + validate_inputs_segregated(list(iv1, iv2)) + list( + "letter" = input[["letter"]], + "number" = input[["number"]] + ) + }) + } + + shiny::testServer(server, { + testthat::expect_warning(values()) + }) +}) + + testthat::test_that("validate_inputs: valid inputs produce desired output", { server <- function(input, output, session) { iv <- shinyvalidate::InputValidator$new() From 9feaacdbe2bc67f02faf4c3db3c86912b9c714aa Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Tue, 3 Jan 2023 13:33:08 +0100 Subject: [PATCH 04/14] more review --- R/validate_inputs.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/validate_inputs.R b/R/validate_inputs.R index ab34202457..2334846b2e 100644 --- a/R/validate_inputs.R +++ b/R/validate_inputs.R @@ -110,8 +110,8 @@ validate_inputs <- function(..., header = "Some inputs require attention") { if (!all(vapply(vals, validator_enabled, logical(1L)))) { warning("Some validators are disabled and will be omitted.", call. = TRUE) + vals <- Filter(validator_enabled, vals) } - vals <- Filter(validator_enabled, vals) fail_messages <- unlist(lapply(vals, gather_messages)) failings <- add_header(fail_messages, header) @@ -127,8 +127,8 @@ validate_inputs_segregated <- function(validators, ...) { if (!all(vapply(validators, validator_enabled, logical(1L)))) { warning("Some validators are disabled and will be omitted.", call. = TRUE) + validators <- Filter(validator_enabled, validators) } - validators <- Filter(validator_enabled, validators) # Since some or all names may be NULL, mapply cannot be used here, a loop is required. fail_messages <- vector("list", length(validators)) From ea1400bd92abac067cf5462db8e94d740489df71 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Tue, 3 Jan 2023 14:14:50 +0100 Subject: [PATCH 05/14] improve unit tests --- tests/testthat/test-validate_inputs.R | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/tests/testthat/test-validate_inputs.R b/tests/testthat/test-validate_inputs.R index e6a75a1b37..03ed6c831b 100644 --- a/tests/testthat/test-validate_inputs.R +++ b/tests/testthat/test-validate_inputs.R @@ -7,11 +7,13 @@ testthat::test_that("invalid arguments raise errors", { testthat::test_that("validate_inputs: disabled validators raise warnings", { server <- function(input, output, session) { - iv <- shinyvalidate::InputValidator$new() - iv$add_rule("letter", shinyvalidate::sv_in_set(LETTERS, "choose a capital letter")) - iv$add_rule("number", ~ if (as.integer(.) %% 2L == 1L) "choose an even number") + iv1 <- shinyvalidate::InputValidator$new() + iv1$add_rule("letter", shinyvalidate::sv_in_set(LETTERS, "choose a capital letter")) + iv1$enable() + iv2 <- shinyvalidate::InputValidator$new() + iv2$add_rule("number", ~ if (as.integer(.) %% 2L == 1L) "choose an even number") values <- shiny::reactive({ - validate_inputs(iv) + validate_inputs(iv1, iv2) list( "letter" = input[["letter"]], "number" = input[["number"]] From 7942d1896693334a837c511a73650cd1ad0bb2d2 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Mon, 9 Jan 2023 11:09:44 +0100 Subject: [PATCH 06/14] apply review --- R/validate_inputs.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/R/validate_inputs.R b/R/validate_inputs.R index 2334846b2e..e24acbb5cf 100644 --- a/R/validate_inputs.R +++ b/R/validate_inputs.R @@ -109,7 +109,7 @@ validate_inputs <- function(..., header = "Some inputs require attention") { checkmate::assert_string(header, null.ok = TRUE) if (!all(vapply(vals, validator_enabled, logical(1L)))) { - warning("Some validators are disabled and will be omitted.", call. = TRUE) + logger::log_warn("Some validators are disabled and will be omitted.") vals <- Filter(validator_enabled, vals) } @@ -126,7 +126,7 @@ validate_inputs_segregated <- function(validators, ...) { checkmate::assert_list(validators, types = "InputValidator") if (!all(vapply(validators, validator_enabled, logical(1L)))) { - warning("Some validators are disabled and will be omitted.", call. = TRUE) + logger::log_warn("Some validators are disabled and will be omitted.") validators <- Filter(validator_enabled, validators) } @@ -172,8 +172,8 @@ gather_and_add <- function(iv, header) { } #' @keywords internal -#' test if an InputValidator object is enabled -#' returns logical of length 1 +# test if an InputValidator object is enabled +# returns logical of length 1 validator_enabled <- function(x) { x$.__enclos_env__$private$enabled } From 8b1bc91adcde025f95df156ca8224dd974c49695 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Tue, 10 Jan 2023 13:16:55 +0100 Subject: [PATCH 07/14] fix unit tests --- tests/testthat/test-validate_inputs.R | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-validate_inputs.R b/tests/testthat/test-validate_inputs.R index 03ed6c831b..696ba0c611 100644 --- a/tests/testthat/test-validate_inputs.R +++ b/tests/testthat/test-validate_inputs.R @@ -22,7 +22,10 @@ testthat::test_that("validate_inputs: disabled validators raise warnings", { } shiny::testServer(server, { - testthat::expect_warning(values()) + testthat::expect_output( + object = values(), + regexp = "\\[WARN\\].+Some validators are disabled and will be omitted." + ) }) }) @@ -44,7 +47,10 @@ testthat::test_that("validate_inputs_segregated: disabled validators raise warni } shiny::testServer(server, { - testthat::expect_warning(values()) + testthat::expect_output( + object = values(), + regexp = "\\[WARN\\].+Some validators are disabled and will be omitted." + ) }) }) From c8f8e29e5d453b8e8de4726c587def54c4cf7fa1 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski <114988527+chlebowa@users.noreply.github.com> Date: Wed, 25 Jan 2023 14:16:18 +0100 Subject: [PATCH 08/14] upgrade `validate_inputs` function (#796) Rewrites `validate_inputs*` functions into a single function. `validate_inputs` will accept an arbitrary number of validators passed directly or as a nested list. Lists are processed recursively. --- NAMESPACE | 1 - NEWS.md | 3 +- R/validate_inputs.R | 138 ++++---- _pkgdown.yml | 2 +- man/validate_inputs.Rd | 36 +- tests/testthat/test-validate_inputs.R | 479 +++++++++++++++++--------- 6 files changed, 399 insertions(+), 260 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index b8695e1796..3eb78536df 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -41,7 +41,6 @@ export(validate_has_elements) export(validate_has_variable) export(validate_in) export(validate_inputs) -export(validate_inputs_segregated) export(validate_n_levels) export(validate_no_intersection) export(validate_one_row_per_id) diff --git a/NEWS.md b/NEWS.md index 0cead9df67..9e5087d10c 100644 --- a/NEWS.md +++ b/NEWS.md @@ -10,7 +10,8 @@ ### New features -* Added the `validate_inputs` and `validate_inputs_segregated` functions that transfer input validation messages to app output. +* Added the `validate_inputs` function that transfers input validation messages to app output. +* `modules` argument of `init` accepts `teal_module` type of object. There is no need to wrap up a single module in `modules()` or `list()`. ### Miscellaneous diff --git a/R/validate_inputs.R b/R/validate_inputs.R index e24acbb5cf..e22d63d3f1 100644 --- a/R/validate_inputs.R +++ b/R/validate_inputs.R @@ -1,5 +1,5 @@ -#' Send input validation messages to output +#' Send input validation messages to output. #' #' Captures messages from `InputValidator` objects and collates them #' into one message passed to `validate`. @@ -9,30 +9,28 @@ #' of the output element. #' `shinyvalidate::InputValidator` allows to validate input elements #' and to display specific messages in their respective input widgets. -#' This function is a hybrid solution. Given an `InputValidator` object, -#' it extracts messages from inputs that fail validation and places them all in one -#' validation message that is passed to a `validate`/`need` call. +#' `validate_inputs` provides a hybrid solution. +#' Given an `InputValidator` object, messages corresponding to inputs that fail validation +#' are extracted and placed in one validation message that is passed to a `validate`/`need` call. #' This way the input validator messages are repeated in the output. #' -#' `validate_inputs` accepts an arbitrary number of `InputValidator`s -#' and prints all messages together, adding one (optional) header. -#' `validate_inputs_segregated` accepts a list of `InputValidator`s -#' and prints messages grouped by validator. If elements of `validators` are named, - -#' the names are used as headers for their respective message groups. -#' +#' The `...` argument accepts any number of `InputValidator` objects +#' or an (possibly infinitely) nested list of such objects. +#' If validators are passed directly, all their messages are printed together +#' under one (optional) header message specified by `header`. If a list is passed, +#' messages are grouped by validator. The list's names are used as headers +#' for their respective message groups. +#' If neither of the nested list elements is named, a header message is taken from `header`. #' -#' @name validate_inputs -#' -#' @param ... for `validate_inputs` any number of `InputValidator` objects \cr -#' for `validate_inputs_segregated` arguments passed to `validate` -#' @param header `character(1)` optional generic validation message -#' @param validators optionally named `list` of `InputValidator` objects, see `Details` +#' @param ... either any number of `InputValidator` objects +#' or an optionally named, possibly nested `list` of `InputValidator` +#' objects, see `Details` +#' @param header `character(1)` generic validation message; set to NULL to omit #' #' @return #' Returns NULL if the final validation call passes and a `shiny.silent.error` if it fails. #' -#' @seealso [`shinyvalidate::InputValidator`] [`shiny::validate`] +#' @seealso [`shinyvalidate::InputValidator`], [`shiny::validate`] #' #' @examples #' library(shiny) @@ -84,7 +82,7 @@ #' validate_inputs(iv_par, header = "Set proper graphical parameters") #' }, #' "combined" = validate_inputs(iv, iv_par), -#' "grouped" = validate_inputs_segregated(list( +#' "grouped" = validate_inputs(list( #' "Some inputs require attention" = iv, #' "Set proper graphical parameters" = iv_par #' )) @@ -101,79 +99,81 @@ #' shinyApp(ui, server) #' } -#' @rdname validate_inputs #' @export validate_inputs <- function(..., header = "Some inputs require attention") { - vals <- list(...) - lapply(vals, checkmate::assert_class, "InputValidator") - checkmate::assert_string(header, null.ok = TRUE) + dots <- list(...) + if (!is_validators(dots)) stop("validate_inputs accepts validators or a list thereof") - if (!all(vapply(vals, validator_enabled, logical(1L)))) { - logger::log_warn("Some validators are disabled and will be omitted.") - vals <- Filter(validator_enabled, vals) + messages <- extract_validator(dots, header) + failings <- if (!any_names(dots)) { + add_header(messages, header) + } else { + unlist(messages) } - fail_messages <- unlist(lapply(vals, gather_messages)) - failings <- add_header(fail_messages, header) - shiny::validate(shiny::need(is.null(failings), failings)) } +### internal functions -#' @rdname validate_inputs -#' @export -validate_inputs_segregated <- function(validators, ...) { - checkmate::assert_list(validators, types = "InputValidator") +#' @keywords internal +# recursive object type test +# returns logical of length 1 +is_validators <- function(x) { + all(if (is.list(x)) unlist(lapply(x, is_validators)) else inherits(x, "InputValidator")) +} - if (!all(vapply(validators, validator_enabled, logical(1L)))) { - logger::log_warn("Some validators are disabled and will be omitted.") - validators <- Filter(validator_enabled, validators) - } +#' @keywords internal +# test if an InputValidator object is enabled +# returns logical of length 1 +validator_enabled <- function(x) { + x$.__enclos_env__$private$enabled +} - # Since some or all names may be NULL, mapply cannot be used here, a loop is required. - fail_messages <- vector("list", length(validators)) - for (v in seq_along(validators)) { - fail_messages[[v]] <- gather_and_add(validators[[v]], names(validators)[v]) +#' @keywords internal +# recursively extract messages from validator list +# returns character vector or a list of character vectors, possibly nested and named +extract_validator <- function(iv, header) { + if (inherits(iv, "InputValidator")) { + add_header(gather_messages(iv), header) + } else { + if (is.null(names(iv))) names(iv) <- rep("", length(iv)) + mapply(extract_validator, iv = iv, header = names(iv), SIMPLIFY = FALSE) } - - failings <- unlist(fail_messages) - - shiny::validate(shiny::need(is.null(failings), failings), ...) } - -### internal functions - #' @keywords internal # collate failing messages from validator +# returns list gather_messages <- function(iv) { - status <- iv$validate() - failing_inputs <- Filter(Negate(is.null), status) - unique(lapply(failing_inputs, function(x) x[["message"]])) -} - -#' @keywords internal -# format failing messages with optional header message -add_header <- function(messages, header) { - if (length(messages) > 0L) { - c(paste0(header, "\n"), unlist(messages), "\n") + if (validator_enabled(iv)) { + status <- iv$validate() + failing_inputs <- Filter(Negate(is.null), status) + unique(lapply(failing_inputs, function(x) x[["message"]])) } else { - NULL + logger::log_warn("Validator is disabled and will be omitted.") + list() } } #' @keywords internal -# collate failing messages with optional header message -# used by segregated method -gather_and_add <- function(iv, header) { - fail_messages <- gather_messages(iv) - failings <- add_header(fail_messages, header) - failings +# add optional header to failing messages +add_header <- function(messages, header = "") { + ans <- unlist(messages) + if (length(ans) != 0L && isTRUE(nchar(header) > 0L)) { + ans <- c(paste0(header, "\n"), ans, "\n") + } + ans } #' @keywords internal -# test if an InputValidator object is enabled -# returns logical of length 1 -validator_enabled <- function(x) { - x$.__enclos_env__$private$enabled +# recursively check if the object contains a named list +any_names <- function(x) { + any( + if (is.list(x)) { + if (!is.null(names(x)) && any(names(x) != "")) TRUE else unlist(lapply(x, any_names)) + } else { + FALSE + } + ) } diff --git a/_pkgdown.yml b/_pkgdown.yml index 1898352a18..d5a16f0c62 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -52,7 +52,7 @@ reference: - title: Validation functions contents: - starts_with("validate_") - - starts_with("validate_inputs") + - validate_inputs - title: Deprecated functions contents: - get_rcode diff --git a/man/validate_inputs.Rd b/man/validate_inputs.Rd index 139a83df1d..e2d6be41ce 100644 --- a/man/validate_inputs.Rd +++ b/man/validate_inputs.Rd @@ -2,20 +2,16 @@ % Please edit documentation in R/validate_inputs.R \name{validate_inputs} \alias{validate_inputs} -\alias{validate_inputs_segregated} -\title{Send input validation messages to output} +\title{Send input validation messages to output.} \usage{ validate_inputs(..., header = "Some inputs require attention") - -validate_inputs_segregated(validators, ...) } \arguments{ -\item{...}{for \code{validate_inputs} any number of \code{InputValidator} objects \cr -for \code{validate_inputs_segregated} arguments passed to \code{validate}} - -\item{header}{\code{character(1)} optional generic validation message} +\item{...}{either any number of \code{InputValidator} objects +or an optionally named, possibly nested \code{list} of \code{InputValidator} +objects, see \code{Details}} -\item{validators}{optionally named \code{list} of \code{InputValidator} objects, see \code{Details}} +\item{header}{\code{character(1)} generic validation message; set to NULL to omit} } \value{ Returns NULL if the final validation call passes and a \code{shiny.silent.error} if it fails. @@ -30,16 +26,18 @@ certain conditions are met and to print a validation message in place of the output element. \code{shinyvalidate::InputValidator} allows to validate input elements and to display specific messages in their respective input widgets. -This function is a hybrid solution. Given an \code{InputValidator} object, -it extracts messages from inputs that fail validation and places them all in one -validation message that is passed to a \code{validate}/\code{need} call. +\code{validate_inputs} provides a hybrid solution. +Given an \code{InputValidator} object, messages corresponding to inputs that fail validation +are extracted and placed in one validation message that is passed to a \code{validate}/\code{need} call. This way the input validator messages are repeated in the output. -\code{validate_inputs} accepts an arbitrary number of \code{InputValidator}s -and prints all messages together, adding one (optional) header. -\code{validate_inputs_segregated} accepts a list of \code{InputValidator}s -and prints messages grouped by validator. If elements of \code{validators} are named, -the names are used as headers for their respective message groups. +The \code{...} argument accepts any number of \code{InputValidator} objects +or an (possibly infinitely) nested list of such objects. +If validators are passed directly, all their messages are printed together +under one (optional) header message specified by \code{header}. If a list is passed, +messages are grouped by validator. The list's names are used as headers +for their respective message groups. +If neither of the nested list elements is named, a header message is taken from \code{header}. } \examples{ library(shiny) @@ -91,7 +89,7 @@ server <- function(input, output) { validate_inputs(iv_par, header = "Set proper graphical parameters") }, "combined" = validate_inputs(iv, iv_par), - "grouped" = validate_inputs_segregated(list( + "grouped" = validate_inputs(list( "Some inputs require attention" = iv, "Set proper graphical parameters" = iv_par )) @@ -109,5 +107,5 @@ if (interactive()) { } } \seealso{ -\code{\link[shinyvalidate:InputValidator]{shinyvalidate::InputValidator}} \code{\link[shiny:validate]{shiny::validate}} +\code{\link[shinyvalidate:InputValidator]{shinyvalidate::InputValidator}}, \code{\link[shiny:validate]{shiny::validate}} } diff --git a/tests/testthat/test-validate_inputs.R b/tests/testthat/test-validate_inputs.R index 696ba0c611..82e6f7c72c 100644 --- a/tests/testthat/test-validate_inputs.R +++ b/tests/testthat/test-validate_inputs.R @@ -1,192 +1,303 @@ testthat::test_that("invalid arguments raise errors", { - testthat::expect_error(validate_inputs("string")) - testthat::expect_error(validate_inputs_segregated(list("name" = "string"))) + testthat::expect_error(validate_inputs("string"), + "validate_inputs accepts validators or a list thereof") + testthat::expect_error(validate_inputs(list("name" = "string")), + "validate_inputs accepts validators or a list thereof") }) -testthat::test_that("validate_inputs: disabled validators raise warnings", { - server <- function(input, output, session) { - iv1 <- shinyvalidate::InputValidator$new() - iv1$add_rule("letter", shinyvalidate::sv_in_set(LETTERS, "choose a capital letter")) - iv1$enable() - iv2 <- shinyvalidate::InputValidator$new() - iv2$add_rule("number", ~ if (as.integer(.) %% 2L == 1L) "choose an even number") - values <- shiny::reactive({ - validate_inputs(iv1, iv2) - list( - "letter" = input[["letter"]], - "number" = input[["number"]] +testthat::test_that( + "validate_inputs: disabled validators raise warnings (individual validators)", + code = { + server <- function(input, output, session) { + iv1 <- shinyvalidate::InputValidator$new() + iv1$add_rule("letter", shinyvalidate::sv_in_set(LETTERS, "choose a capital letter")) + iv1$enable() + iv2 <- shinyvalidate::InputValidator$new() + iv2$add_rule("number", ~ if (as.integer(.) %% 2L == 1L) "choose an even number") + values <- shiny::reactive({ + validate_inputs(iv1, iv2) + list( + "letter" = input[["letter"]], + "number" = input[["number"]] + ) + }) + } + + shiny::testServer(server, { + testthat::expect_output( + object = values(), + regexp = "\\[WARN\\].+Validator is disabled and will be omitted." ) }) - } - - shiny::testServer(server, { - testthat::expect_output( - object = values(), - regexp = "\\[WARN\\].+Some validators are disabled and will be omitted." - ) }) -}) -testthat::test_that("validate_inputs_segregated: disabled validators raise warnings", { - server <- function(input, output, session) { - iv1 <- shinyvalidate::InputValidator$new() - iv1$add_rule("letter", shinyvalidate::sv_in_set(LETTERS, "choose a capital letter")) - iv1$enable() - iv2 <- shinyvalidate::InputValidator$new() - iv2$add_rule("number", ~ if (as.integer(.) %% 2L == 1L) "choose an even number") - values <- shiny::reactive({ - validate_inputs_segregated(list(iv1, iv2)) - list( - "letter" = input[["letter"]], - "number" = input[["number"]] +testthat::test_that( + "validate_inputs_segregated: disabled validators raise warnings (validator list)", + code = { + server <- function(input, output, session) { + iv1 <- shinyvalidate::InputValidator$new() + iv1$add_rule("letter", shinyvalidate::sv_in_set(LETTERS, "choose a capital letter")) + iv1$enable() + iv2 <- shinyvalidate::InputValidator$new() + iv2$add_rule("number", ~ if (as.integer(.) %% 2L == 1L) "choose an even number") + values <- shiny::reactive({ + validate_inputs(list(iv1, iv2)) + list( + "letter" = input[["letter"]], + "number" = input[["number"]] + ) + }) + } + + shiny::testServer(server, { + testthat::expect_output( + object = values(), + regexp = "\\[WARN\\].+Validator is disabled and will be omitted." ) }) - } - - shiny::testServer(server, { - testthat::expect_output( - object = values(), - regexp = "\\[WARN\\].+Some validators are disabled and will be omitted." - ) }) -}) -testthat::test_that("validate_inputs: valid inputs produce desired output", { - server <- function(input, output, session) { - iv <- shinyvalidate::InputValidator$new() - iv$add_rule("letter", shinyvalidate::sv_in_set(LETTERS, "choose a capital letter")) - iv$add_rule("number", ~ if (as.integer(.) %% 2L == 1L) "choose an even number") - iv$enable() - values <- shiny::reactive({ - validate_inputs(iv) - list( - "letter" = input[["letter"]], - "number" = input[["number"]] +testthat::test_that( + "validate_inputs_segregated: disabled validators raise warnings (nested validator list)", + code = { + server <- function(input, output, session) { + iv1 <- shinyvalidate::InputValidator$new() + iv1$add_rule("letter", shinyvalidate::sv_in_set(LETTERS, "choose a capital letter")) + iv1$enable() + iv2 <- shinyvalidate::InputValidator$new() + iv2$add_rule("number", ~ if (as.integer(.) %% 2L == 1L) "choose an even number") + values <- shiny::reactive({ + validate_inputs(list(list(iv1), list(iv2))) + list( + "letter" = input[["letter"]], + "number" = input[["number"]] + ) + }) + } + + shiny::testServer(server, { + testthat::expect_output( + object = values(), + regexp = "\\[WARN\\].+Validator is disabled and will be omitted." ) }) - } - - shiny::testServer(server, { - session$setInputs( - "letter" = "A", - "number" = 2L - ) - testthat::expect_identical(values(), list( - "letter" = input[["letter"]], - "number" = input[["number"]] - )) }) -}) -testthat::test_that("validate_inputs_segregated: valid inputs produce desired output", { - server <- function(input, output, session) { - iv <- shinyvalidate::InputValidator$new() - iv$add_rule("letter", shinyvalidate::sv_in_set(LETTERS, "choose a capital letter")) - iv$add_rule("number", ~ if (as.integer(.) %% 2L == 1L) "choose an even number") - iv$enable() - values <- shiny::reactive({ - validate_inputs_segregated(list(iv)) - list( +testthat::test_that( + "validate_inputs: valid inputs produce desired output (individual validators)", + code = { + server <- function(input, output, session) { + iv <- shinyvalidate::InputValidator$new() + iv$add_rule("letter", shinyvalidate::sv_in_set(LETTERS, "choose a capital letter")) + iv$add_rule("number", ~ if (as.integer(.) %% 2L == 1L) "choose an even number") + iv$enable() + values <- shiny::reactive({ + validate_inputs(iv) + list( + "letter" = input[["letter"]], + "number" = input[["number"]] + ) + }) + } + + shiny::testServer(server, { + session$setInputs( + "letter" = "A", + "number" = 2L + ) + testthat::expect_identical(values(), list( "letter" = input[["letter"]], "number" = input[["number"]] - ) + )) }) - } - - shiny::testServer(server, { - session$setInputs( - "letter" = "A", - "number" = 2L - ) - testthat::expect_identical(values(), list( - "letter" = input[["letter"]], - "number" = input[["number"]] - )) }) -}) -testthat::test_that("validate_inputs: invalid inputs raise errors in output", { - server <- function(input, output, session) { - iv <- shinyvalidate::InputValidator$new() - iv$add_rule("letter", shinyvalidate::sv_in_set(LETTERS, "choose a capital letter")) - iv$add_rule("number", ~ if (as.integer(.) %% 2L == 1L) "choose an even number") - iv$enable() - values <- shiny::reactive({ - validate_inputs(iv) - list( +testthat::test_that( + "validate_inputs_segregated: valid inputs produce desired output (validator list)", + code = { + server <- function(input, output, session) { + iv <- shinyvalidate::InputValidator$new() + iv$add_rule("letter", shinyvalidate::sv_in_set(LETTERS, "choose a capital letter")) + iv$add_rule("number", ~ if (as.integer(.) %% 2L == 1L) "choose an even number") + iv$enable() + values <- shiny::reactive({ + validate_inputs(list(iv)) + list( + "letter" = input[["letter"]], + "number" = input[["number"]] + ) + }) + } + + shiny::testServer(server, { + session$setInputs( + "letter" = "A", + "number" = 2L + ) + testthat::expect_identical(values(), list( "letter" = input[["letter"]], "number" = input[["number"]] - ) + )) }) - } - - shiny::testServer(server, { - session$setInputs( - "letter" = "a", - "number" = 2L - ) - testthat::expect_error(values()) - }) - shiny::testServer(server, { - session$setInputs( - "letter" = "A", - "number" = 1L - ) - testthat::expect_error(values()) }) - shiny::testServer(server, { - session$setInputs( - "letter" = "a", - "number" = 1L - ) - testthat::expect_error(values()) - }) -}) -testthat::test_that("validate_inputs_segregated: invalid inputs raise errors in output", { - server <- function(input, output, session) { - iv <- shinyvalidate::InputValidator$new() - iv$add_rule("letter", shinyvalidate::sv_in_set(LETTERS, "choose a capital letter")) - iv$add_rule("number", ~ if (as.integer(.) %% 2L == 1L) "choose an even number") - iv$enable() - values <- shiny::reactive({ - validate_inputs_segregated(list(iv)) - list( +testthat::test_that( + "validate_inputs_segregated: valid inputs produce desired output (nested validator list)", + code = { + server <- function(input, output, session) { + iv <- shinyvalidate::InputValidator$new() + iv$add_rule("letter", shinyvalidate::sv_in_set(LETTERS, "choose a capital letter")) + iv$add_rule("number", ~ if (as.integer(.) %% 2L == 1L) "choose an even number") + iv$enable() + values <- shiny::reactive({ + validate_inputs(list(list(iv))) + list( + "letter" = input[["letter"]], + "number" = input[["number"]] + ) + }) + } + + shiny::testServer(server, { + session$setInputs( + "letter" = "A", + "number" = 2L + ) + testthat::expect_identical(values(), list( "letter" = input[["letter"]], "number" = input[["number"]] - ) + )) }) - } + }) - shiny::testServer(server, { - session$setInputs( - "letter" = "a", - "number" = 2L - ) - testthat::expect_error(values()) + +testthat::test_that( + "validate_inputs: invalid inputs raise errors in output (individual validators)", + code = { + server <- function(input, output, session) { + iv <- shinyvalidate::InputValidator$new() + iv$add_rule("letter", shinyvalidate::sv_in_set(LETTERS, "choose a capital letter")) + iv$add_rule("number", ~ if (as.integer(.) %% 2L == 1L) "choose an even number") + iv$enable() + values <- shiny::reactive({ + validate_inputs(iv) + list( + "letter" = input[["letter"]], + "number" = input[["number"]] + ) + }) + } + + shiny::testServer(server, { + session$setInputs( + "letter" = "a", + "number" = 2L + ) + testthat::expect_error(values(), "choose a capital letter") + }) + shiny::testServer(server, { + session$setInputs( + "letter" = "A", + "number" = 1L + ) + testthat::expect_error(values(), "choose an even number") + }) + shiny::testServer(server, { + session$setInputs( + "letter" = "a", + "number" = 1L + ) + testthat::expect_error(values(), "choose a capital letter.+choose an even number") + }) }) - shiny::testServer(server, { - session$setInputs( - "letter" = "A", - "number" = 1L - ) - testthat::expect_error(values()) + + +testthat::test_that( + "validate_inputs_segregated: invalid inputs raise errors in output (validator list)", + code = { + server <- function(input, output, session) { + iv <- shinyvalidate::InputValidator$new() + iv$add_rule("letter", shinyvalidate::sv_in_set(LETTERS, "choose a capital letter")) + iv$add_rule("number", ~ if (as.integer(.) %% 2L == 1L) "choose an even number") + iv$enable() + values <- shiny::reactive({ + validate_inputs(list(iv)) + list( + "letter" = input[["letter"]], + "number" = input[["number"]] + ) + }) + } + + shiny::testServer(server, { + session$setInputs( + "letter" = "a", + "number" = 2L + ) + testthat::expect_error(values(), "choose a capital letter") + }) + shiny::testServer(server, { + session$setInputs( + "letter" = "A", + "number" = 1L + ) + testthat::expect_error(values(), "choose an even number") + }) + shiny::testServer(server, { + session$setInputs( + "letter" = "a", + "number" = 1L + ) + testthat::expect_error(values(), "choose a capital letter.+choose an even number") + }) }) - shiny::testServer(server, { - session$setInputs( - "letter" = "a", - "number" = 1L - ) - testthat::expect_error(values()) + +testthat::test_that( + "validate_inputs_segregated: invalid inputs raise errors in output (nested validator list)", + code = { + server <- function(input, output, session) { + iv <- shinyvalidate::InputValidator$new() + iv$add_rule("letter", shinyvalidate::sv_in_set(LETTERS, "choose a capital letter")) + iv$add_rule("number", ~ if (as.integer(.) %% 2L == 1L) "choose an even number") + iv$enable() + values <- shiny::reactive({ + validate_inputs(list(iv)) + list( + "letter" = input[["letter"]], + "number" = input[["number"]] + ) + }) + } + + shiny::testServer(server, { + session$setInputs( + "letter" = "a", + "number" = 2L + ) + testthat::expect_error(values(), "choose a capital letter") + }) + shiny::testServer(server, { + session$setInputs( + "letter" = "A", + "number" = 1L + ) + testthat::expect_error(values(), "choose an even number") + }) + shiny::testServer(server, { + session$setInputs( + "letter" = "a", + "number" = 1L + ) + testthat::expect_error(values(), "choose a capital letter.+choose an even number") + }) }) -}) testthat::test_that("error message is formatted properly", { @@ -214,17 +325,13 @@ testthat::test_that("error message is formatted properly", { "color" = "", "size" = 0.25 ) + # check error class - testthat::expect_error(validate_inputs(iv)) - testthat::expect_error(validate_inputs(iv, iv_par)) - testthat::expect_error(validate_inputs_segregated(list(iv)), class = "shiny.silent.error") - testthat::expect_error(validate_inputs_segregated(list(iv, iv_par)), class = "shiny.silent.error") - testthat::expect_error(validate_inputs_segregated(list(iv), errorClass = "custom.error.class"), - class = "custom.error.class" - ) - testthat::expect_error(validate_inputs_segregated(list(iv, iv_par), errorClass = "custom.error.class"), - class = "custom.error.class" - ) + testthat::expect_error(validate_inputs(iv), class = "shiny.silent.error") + testthat::expect_error(validate_inputs(iv, iv_par), class = "shiny.silent.error") + testthat::expect_error(validate_inputs(list(iv)), class = "shiny.silent.error") + testthat::expect_error(validate_inputs(list(iv, iv_par)), class = "shiny.silent.error") + testthat::expect_error(validate_inputs(list(iv, list(iv_par))), class = "shiny.silent.error") # check error message errmess <- tryCatch(validate_inputs(iv), error = function(e) e$message) @@ -251,10 +358,10 @@ testthat::test_that("error message is formatted properly", { collapse = "\n" )) - errmess <- tryCatch(validate_inputs_segregated(list(iv)), error = function(e) e$message) + errmess <- tryCatch(validate_inputs(list(iv)), error = function(e) e$message) testthat::expect_identical(errmess, paste( c( - "\n", + "Some inputs require attention\n", "choose a capital letter", "choose an even number", "\n" @@ -262,14 +369,25 @@ testthat::test_that("error message is formatted properly", { collapse = "\n" )) - errmess <- tryCatch(validate_inputs_segregated(list(iv, iv_par)), error = function(e) e$message) + errmess <- tryCatch(validate_inputs(list(iv, iv_par)), error = function(e) e$message) testthat::expect_identical(errmess, paste( c( - "\n", + "Some inputs require attention\n", + "choose a capital letter", + "choose an even number", + "choose a color", + "choose a value between 0.5 and 3", + "\n" + ), + collapse = "\n" + )) + + errmess <- tryCatch(validate_inputs(list(iv, list(iv_par))), error = function(e) e$message) + testthat::expect_identical(errmess, paste( + c( + "Some inputs require attention\n", "choose a capital letter", "choose an even number", - "\n", - "\n", "choose a color", "choose a value between 0.5 and 3", "\n" @@ -302,7 +420,7 @@ testthat::test_that("error message is formatted properly", { collapse = "\n" )) - errmess <- tryCatch(validate_inputs_segregated(list("Header message" = iv)), error = function(e) e$message) + errmess <- tryCatch(validate_inputs(list("Header message" = iv)), error = function(e) e$message) testthat::expect_identical(errmess, paste( c( "Header message\n", @@ -314,7 +432,7 @@ testthat::test_that("error message is formatted properly", { )) errmess <- tryCatch( - validate_inputs_segregated(list( + validate_inputs(list( "Header message 1" = iv, "Header message 2" = iv_par )), @@ -333,6 +451,29 @@ testthat::test_that("error message is formatted properly", { ), collapse = "\n" )) + + errmess <- tryCatch( + validate_inputs(list( + "Header message 1" = iv, + list( + "Header message 2" = iv_par + ) + )), + error = function(e) e$message + ) + testthat::expect_identical(errmess, paste( + c( + "Header message 1\n", + "choose a capital letter", + "choose an even number", + "\n", + "Header message 2\n", + "choose a color", + "choose a value between 0.5 and 3", + "\n" + ), + collapse = "\n" + )) }) }) @@ -374,7 +515,7 @@ testthat::test_that("different validation modes produce proper messages", { ) }) values_g <- shiny::reactive({ - validate_inputs_segregated(list("Main validator" = iv, "Graphical validator" = iv_par)) + validate_inputs(list("Main validator" = iv, "Graphical validator" = iv_par)) list( "letter" = input[["letter"]], "number" = input[["number"]], From 913ece19e86d21b3384ff8f43b22d8ec31218c30 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Wed, 25 Jan 2023 14:29:48 +0100 Subject: [PATCH 09/14] apply code review --- R/validate_inputs.R | 3 ++- man/validate_inputs.Rd | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/R/validate_inputs.R b/R/validate_inputs.R index e22d63d3f1..031e8cd74f 100644 --- a/R/validate_inputs.R +++ b/R/validate_inputs.R @@ -15,7 +15,7 @@ #' This way the input validator messages are repeated in the output. #' #' The `...` argument accepts any number of `InputValidator` objects -#' or an (possibly infinitely) nested list of such objects. +#' or a nested list of such objects. #' If validators are passed directly, all their messages are printed together #' under one (optional) header message specified by `header`. If a list is passed, #' messages are grouped by validator. The list's names are used as headers @@ -126,6 +126,7 @@ is_validators <- function(x) { #' @keywords internal # test if an InputValidator object is enabled # returns logical of length 1 +# official method requested at https://github.com/rstudio/shinyvalidate/issues/64 validator_enabled <- function(x) { x$.__enclos_env__$private$enabled } diff --git a/man/validate_inputs.Rd b/man/validate_inputs.Rd index e2d6be41ce..94242e9268 100644 --- a/man/validate_inputs.Rd +++ b/man/validate_inputs.Rd @@ -32,7 +32,7 @@ are extracted and placed in one validation message that is passed to a \code{val This way the input validator messages are repeated in the output. The \code{...} argument accepts any number of \code{InputValidator} objects -or an (possibly infinitely) nested list of such objects. +or a nested list of such objects. If validators are passed directly, all their messages are printed together under one (optional) header message specified by \code{header}. If a list is passed, messages are grouped by validator. The list's names are used as headers From 0247c66d6a37a2ace7cbde284d01bc5fbccac38b Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Wed, 25 Jan 2023 14:36:57 +0100 Subject: [PATCH 10/14] amend unit tests --- tests/testthat/test-validate_inputs.R | 474 +++++++++++++------------- 1 file changed, 228 insertions(+), 246 deletions(-) diff --git a/tests/testthat/test-validate_inputs.R b/tests/testthat/test-validate_inputs.R index 82e6f7c72c..84ecfd2ba3 100644 --- a/tests/testthat/test-validate_inputs.R +++ b/tests/testthat/test-validate_inputs.R @@ -7,297 +7,279 @@ testthat::test_that("invalid arguments raise errors", { }) -testthat::test_that( - "validate_inputs: disabled validators raise warnings (individual validators)", - code = { - server <- function(input, output, session) { - iv1 <- shinyvalidate::InputValidator$new() - iv1$add_rule("letter", shinyvalidate::sv_in_set(LETTERS, "choose a capital letter")) - iv1$enable() - iv2 <- shinyvalidate::InputValidator$new() - iv2$add_rule("number", ~ if (as.integer(.) %% 2L == 1L) "choose an even number") - values <- shiny::reactive({ - validate_inputs(iv1, iv2) - list( - "letter" = input[["letter"]], - "number" = input[["number"]] - ) - }) - } - - shiny::testServer(server, { - testthat::expect_output( - object = values(), - regexp = "\\[WARN\\].+Validator is disabled and will be omitted." +testthat::test_that("disabled validators raise warnings (individual validators)", { + server <- function(input, output, session) { + iv1 <- shinyvalidate::InputValidator$new() + iv1$add_rule("letter", shinyvalidate::sv_in_set(LETTERS, "choose a capital letter")) + iv1$enable() + iv2 <- shinyvalidate::InputValidator$new() + iv2$add_rule("number", ~ if (as.integer(.) %% 2L == 1L) "choose an even number") + values <- shiny::reactive({ + validate_inputs(iv1, iv2) + list( + "letter" = input[["letter"]], + "number" = input[["number"]] ) }) - }) + } + shiny::testServer(server, { + testthat::expect_output( + object = values(), + regexp = "\\[WARN\\].+Validator is disabled and will be omitted." + ) + }) +}) -testthat::test_that( - "validate_inputs_segregated: disabled validators raise warnings (validator list)", - code = { - server <- function(input, output, session) { - iv1 <- shinyvalidate::InputValidator$new() - iv1$add_rule("letter", shinyvalidate::sv_in_set(LETTERS, "choose a capital letter")) - iv1$enable() - iv2 <- shinyvalidate::InputValidator$new() - iv2$add_rule("number", ~ if (as.integer(.) %% 2L == 1L) "choose an even number") - values <- shiny::reactive({ - validate_inputs(list(iv1, iv2)) - list( - "letter" = input[["letter"]], - "number" = input[["number"]] - ) - }) - } - shiny::testServer(server, { - testthat::expect_output( - object = values(), - regexp = "\\[WARN\\].+Validator is disabled and will be omitted." +testthat::test_that("disabled validators raise warnings (validator list)", { + server <- function(input, output, session) { + iv1 <- shinyvalidate::InputValidator$new() + iv1$add_rule("letter", shinyvalidate::sv_in_set(LETTERS, "choose a capital letter")) + iv1$enable() + iv2 <- shinyvalidate::InputValidator$new() + iv2$add_rule("number", ~ if (as.integer(.) %% 2L == 1L) "choose an even number") + values <- shiny::reactive({ + validate_inputs(list(iv1, iv2)) + list( + "letter" = input[["letter"]], + "number" = input[["number"]] ) }) - }) + } + shiny::testServer(server, { + testthat::expect_output( + object = values(), + regexp = "\\[WARN\\].+Validator is disabled and will be omitted." + ) + }) +}) -testthat::test_that( - "validate_inputs_segregated: disabled validators raise warnings (nested validator list)", - code = { - server <- function(input, output, session) { - iv1 <- shinyvalidate::InputValidator$new() - iv1$add_rule("letter", shinyvalidate::sv_in_set(LETTERS, "choose a capital letter")) - iv1$enable() - iv2 <- shinyvalidate::InputValidator$new() - iv2$add_rule("number", ~ if (as.integer(.) %% 2L == 1L) "choose an even number") - values <- shiny::reactive({ - validate_inputs(list(list(iv1), list(iv2))) - list( - "letter" = input[["letter"]], - "number" = input[["number"]] - ) - }) - } - shiny::testServer(server, { - testthat::expect_output( - object = values(), - regexp = "\\[WARN\\].+Validator is disabled and will be omitted." +testthat::test_that("disabled validators raise warnings (nested validator list)", { + server <- function(input, output, session) { + iv1 <- shinyvalidate::InputValidator$new() + iv1$add_rule("letter", shinyvalidate::sv_in_set(LETTERS, "choose a capital letter")) + iv1$enable() + iv2 <- shinyvalidate::InputValidator$new() + iv2$add_rule("number", ~ if (as.integer(.) %% 2L == 1L) "choose an even number") + values <- shiny::reactive({ + validate_inputs(list(list(iv1), list(iv2))) + list( + "letter" = input[["letter"]], + "number" = input[["number"]] ) }) - }) + } + shiny::testServer(server, { + testthat::expect_output( + object = values(), + regexp = "\\[WARN\\].+Validator is disabled and will be omitted." + ) + }) +}) -testthat::test_that( - "validate_inputs: valid inputs produce desired output (individual validators)", - code = { - server <- function(input, output, session) { - iv <- shinyvalidate::InputValidator$new() - iv$add_rule("letter", shinyvalidate::sv_in_set(LETTERS, "choose a capital letter")) - iv$add_rule("number", ~ if (as.integer(.) %% 2L == 1L) "choose an even number") - iv$enable() - values <- shiny::reactive({ - validate_inputs(iv) - list( - "letter" = input[["letter"]], - "number" = input[["number"]] - ) - }) - } - shiny::testServer(server, { - session$setInputs( - "letter" = "A", - "number" = 2L - ) - testthat::expect_identical(values(), list( +testthat::test_that("valid inputs produce desired output (individual validators)", { + server <- function(input, output, session) { + iv <- shinyvalidate::InputValidator$new() + iv$add_rule("letter", shinyvalidate::sv_in_set(LETTERS, "choose a capital letter")) + iv$add_rule("number", ~ if (as.integer(.) %% 2L == 1L) "choose an even number") + iv$enable() + values <- shiny::reactive({ + validate_inputs(iv) + list( "letter" = input[["letter"]], "number" = input[["number"]] - )) + ) }) - }) + } + shiny::testServer(server, { + session$setInputs( + "letter" = "A", + "number" = 2L + ) + testthat::expect_identical(values(), list( + "letter" = input[["letter"]], + "number" = input[["number"]] + )) + }) +}) -testthat::test_that( - "validate_inputs_segregated: valid inputs produce desired output (validator list)", - code = { - server <- function(input, output, session) { - iv <- shinyvalidate::InputValidator$new() - iv$add_rule("letter", shinyvalidate::sv_in_set(LETTERS, "choose a capital letter")) - iv$add_rule("number", ~ if (as.integer(.) %% 2L == 1L) "choose an even number") - iv$enable() - values <- shiny::reactive({ - validate_inputs(list(iv)) - list( - "letter" = input[["letter"]], - "number" = input[["number"]] - ) - }) - } - shiny::testServer(server, { - session$setInputs( - "letter" = "A", - "number" = 2L - ) - testthat::expect_identical(values(), list( +testthat::test_that("valid inputs produce desired output (validator list)", { + server <- function(input, output, session) { + iv <- shinyvalidate::InputValidator$new() + iv$add_rule("letter", shinyvalidate::sv_in_set(LETTERS, "choose a capital letter")) + iv$add_rule("number", ~ if (as.integer(.) %% 2L == 1L) "choose an even number") + iv$enable() + values <- shiny::reactive({ + validate_inputs(list(iv)) + list( "letter" = input[["letter"]], "number" = input[["number"]] - )) + ) }) - }) + } + shiny::testServer(server, { + session$setInputs( + "letter" = "A", + "number" = 2L + ) + testthat::expect_identical(values(), list( + "letter" = input[["letter"]], + "number" = input[["number"]] + )) + }) +}) -testthat::test_that( - "validate_inputs_segregated: valid inputs produce desired output (nested validator list)", - code = { - server <- function(input, output, session) { - iv <- shinyvalidate::InputValidator$new() - iv$add_rule("letter", shinyvalidate::sv_in_set(LETTERS, "choose a capital letter")) - iv$add_rule("number", ~ if (as.integer(.) %% 2L == 1L) "choose an even number") - iv$enable() - values <- shiny::reactive({ - validate_inputs(list(list(iv))) - list( - "letter" = input[["letter"]], - "number" = input[["number"]] - ) - }) - } - shiny::testServer(server, { - session$setInputs( - "letter" = "A", - "number" = 2L - ) - testthat::expect_identical(values(), list( +testthat::test_that("valid inputs produce desired output (nested validator list)", { + server <- function(input, output, session) { + iv <- shinyvalidate::InputValidator$new() + iv$add_rule("letter", shinyvalidate::sv_in_set(LETTERS, "choose a capital letter")) + iv$add_rule("number", ~ if (as.integer(.) %% 2L == 1L) "choose an even number") + iv$enable() + values <- shiny::reactive({ + validate_inputs(list(list(iv))) + list( "letter" = input[["letter"]], "number" = input[["number"]] - )) + ) }) + } + + shiny::testServer(server, { + session$setInputs( + "letter" = "A", + "number" = 2L + ) + testthat::expect_identical(values(), list( + "letter" = input[["letter"]], + "number" = input[["number"]] + )) }) +}) -testthat::test_that( - "validate_inputs: invalid inputs raise errors in output (individual validators)", - code = { - server <- function(input, output, session) { - iv <- shinyvalidate::InputValidator$new() - iv$add_rule("letter", shinyvalidate::sv_in_set(LETTERS, "choose a capital letter")) - iv$add_rule("number", ~ if (as.integer(.) %% 2L == 1L) "choose an even number") - iv$enable() - values <- shiny::reactive({ - validate_inputs(iv) - list( - "letter" = input[["letter"]], - "number" = input[["number"]] - ) - }) - } - - shiny::testServer(server, { - session$setInputs( - "letter" = "a", - "number" = 2L - ) - testthat::expect_error(values(), "choose a capital letter") - }) - shiny::testServer(server, { - session$setInputs( - "letter" = "A", - "number" = 1L - ) - testthat::expect_error(values(), "choose an even number") - }) - shiny::testServer(server, { - session$setInputs( - "letter" = "a", - "number" = 1L +testthat::test_that("invalid inputs raise errors in output (individual validators)", { + server <- function(input, output, session) { + iv <- shinyvalidate::InputValidator$new() + iv$add_rule("letter", shinyvalidate::sv_in_set(LETTERS, "choose a capital letter")) + iv$add_rule("number", ~ if (as.integer(.) %% 2L == 1L) "choose an even number") + iv$enable() + values <- shiny::reactive({ + validate_inputs(iv) + list( + "letter" = input[["letter"]], + "number" = input[["number"]] ) - testthat::expect_error(values(), "choose a capital letter.+choose an even number") }) - }) + } + shiny::testServer(server, { + session$setInputs( + "letter" = "a", + "number" = 2L + ) + testthat::expect_error(values(), "choose a capital letter") + }) + shiny::testServer(server, { + session$setInputs( + "letter" = "A", + "number" = 1L + ) + testthat::expect_error(values(), "choose an even number") + }) + shiny::testServer(server, { + session$setInputs( + "letter" = "a", + "number" = 1L + ) + testthat::expect_error(values(), "choose a capital letter.+choose an even number") + }) +}) -testthat::test_that( - "validate_inputs_segregated: invalid inputs raise errors in output (validator list)", - code = { - server <- function(input, output, session) { - iv <- shinyvalidate::InputValidator$new() - iv$add_rule("letter", shinyvalidate::sv_in_set(LETTERS, "choose a capital letter")) - iv$add_rule("number", ~ if (as.integer(.) %% 2L == 1L) "choose an even number") - iv$enable() - values <- shiny::reactive({ - validate_inputs(list(iv)) - list( - "letter" = input[["letter"]], - "number" = input[["number"]] - ) - }) - } - shiny::testServer(server, { - session$setInputs( - "letter" = "a", - "number" = 2L - ) - testthat::expect_error(values(), "choose a capital letter") - }) - shiny::testServer(server, { - session$setInputs( - "letter" = "A", - "number" = 1L - ) - testthat::expect_error(values(), "choose an even number") - }) - shiny::testServer(server, { - session$setInputs( - "letter" = "a", - "number" = 1L +testthat::test_that("invalid inputs raise errors in output (validator list)", { + server <- function(input, output, session) { + iv <- shinyvalidate::InputValidator$new() + iv$add_rule("letter", shinyvalidate::sv_in_set(LETTERS, "choose a capital letter")) + iv$add_rule("number", ~ if (as.integer(.) %% 2L == 1L) "choose an even number") + iv$enable() + values <- shiny::reactive({ + validate_inputs(list(iv)) + list( + "letter" = input[["letter"]], + "number" = input[["number"]] ) - testthat::expect_error(values(), "choose a capital letter.+choose an even number") }) - }) + } -testthat::test_that( - "validate_inputs_segregated: invalid inputs raise errors in output (nested validator list)", - code = { - server <- function(input, output, session) { - iv <- shinyvalidate::InputValidator$new() - iv$add_rule("letter", shinyvalidate::sv_in_set(LETTERS, "choose a capital letter")) - iv$add_rule("number", ~ if (as.integer(.) %% 2L == 1L) "choose an even number") - iv$enable() - values <- shiny::reactive({ - validate_inputs(list(iv)) - list( - "letter" = input[["letter"]], - "number" = input[["number"]] - ) - }) - } + shiny::testServer(server, { + session$setInputs( + "letter" = "a", + "number" = 2L + ) + testthat::expect_error(values(), "choose a capital letter") + }) + shiny::testServer(server, { + session$setInputs( + "letter" = "A", + "number" = 1L + ) + testthat::expect_error(values(), "choose an even number") + }) + shiny::testServer(server, { + session$setInputs( + "letter" = "a", + "number" = 1L + ) + testthat::expect_error(values(), "choose a capital letter.+choose an even number") + }) +}) - shiny::testServer(server, { - session$setInputs( - "letter" = "a", - "number" = 2L - ) - testthat::expect_error(values(), "choose a capital letter") - }) - shiny::testServer(server, { - session$setInputs( - "letter" = "A", - "number" = 1L - ) - testthat::expect_error(values(), "choose an even number") - }) - shiny::testServer(server, { - session$setInputs( - "letter" = "a", - "number" = 1L +testthat::test_that("invalid inputs raise errors in output (nested validator list)", { + server <- function(input, output, session) { + iv <- shinyvalidate::InputValidator$new() + iv$add_rule("letter", shinyvalidate::sv_in_set(LETTERS, "choose a capital letter")) + iv$add_rule("number", ~ if (as.integer(.) %% 2L == 1L) "choose an even number") + iv$enable() + values <- shiny::reactive({ + validate_inputs(list(iv)) + list( + "letter" = input[["letter"]], + "number" = input[["number"]] ) - testthat::expect_error(values(), "choose a capital letter.+choose an even number") }) + } + + shiny::testServer(server, { + session$setInputs( + "letter" = "a", + "number" = 2L + ) + testthat::expect_error(values(), "choose a capital letter") + }) + shiny::testServer(server, { + session$setInputs( + "letter" = "A", + "number" = 1L + ) + testthat::expect_error(values(), "choose an even number") }) + shiny::testServer(server, { + session$setInputs( + "letter" = "a", + "number" = 1L + ) + testthat::expect_error(values(), "choose a capital letter.+choose an even number") + }) +}) testthat::test_that("error message is formatted properly", { From 477cf58c974d49448d7b51af9b1929f3810e1212 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Wed, 25 Jan 2023 14:44:10 +0100 Subject: [PATCH 11/14] update pkgdown --- _pkgdown.yml | 1 - 1 file changed, 1 deletion(-) diff --git a/_pkgdown.yml b/_pkgdown.yml index d5a16f0c62..7d96c4e7cb 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -52,7 +52,6 @@ reference: - title: Validation functions contents: - starts_with("validate_") - - validate_inputs - title: Deprecated functions contents: - get_rcode From 83fb7c3b05938dd6b81d6cab1af8f3ad9b7ae755 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Wed, 25 Jan 2023 14:45:11 +0100 Subject: [PATCH 12/14] tweak docs --- R/validate_inputs.R | 3 ++- man/validate_inputs.Rd | 1 + 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/R/validate_inputs.R b/R/validate_inputs.R index 031e8cd74f..5b66f02b86 100644 --- a/R/validate_inputs.R +++ b/R/validate_inputs.R @@ -98,8 +98,9 @@ #' if (interactive()) { #' shinyApp(ui, server) #' } - +#' #' @export +#' validate_inputs <- function(..., header = "Some inputs require attention") { dots <- list(...) if (!is_validators(dots)) stop("validate_inputs accepts validators or a list thereof") diff --git a/man/validate_inputs.Rd b/man/validate_inputs.Rd index 94242e9268..5f31a495f5 100644 --- a/man/validate_inputs.Rd +++ b/man/validate_inputs.Rd @@ -105,6 +105,7 @@ server <- function(input, output) { if (interactive()) { shinyApp(ui, server) } + } \seealso{ \code{\link[shinyvalidate:InputValidator]{shinyvalidate::InputValidator}}, \code{\link[shiny:validate]{shiny::validate}} From be4333657b2b8b7b1a4e8d906e2d787dad4bbd72 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Wed, 25 Jan 2023 15:16:41 +0100 Subject: [PATCH 13/14] more unit tests --- tests/testthat/test-validate_inputs.R | 21 ++++++++++++++++++++- 1 file changed, 20 insertions(+), 1 deletion(-) diff --git a/tests/testthat/test-validate_inputs.R b/tests/testthat/test-validate_inputs.R index 84ecfd2ba3..b9ed3e66aa 100644 --- a/tests/testthat/test-validate_inputs.R +++ b/tests/testthat/test-validate_inputs.R @@ -250,7 +250,7 @@ testthat::test_that("invalid inputs raise errors in output (nested validator lis iv$add_rule("number", ~ if (as.integer(.) %% 2L == 1L) "choose an even number") iv$enable() values <- shiny::reactive({ - validate_inputs(list(iv)) + validate_inputs(list(list(iv))) list( "letter" = input[["letter"]], "number" = input[["number"]] @@ -456,6 +456,25 @@ testthat::test_that("error message is formatted properly", { ), collapse = "\n" )) + + errmess <- tryCatch( + validate_inputs(list( + iv, + "Header message" = iv_par + )), + error = function(e) e$message + ) + testthat::expect_identical(errmess, paste( + c( + "choose a capital letter", + "choose an even number", + "Header message\n", + "choose a color", + "choose a value between 0.5 and 3", + "\n" + ), + collapse = "\n" + )) }) }) From c523febfbdd398c261cc5f06c54cc8bf6c33c89b Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski Date: Wed, 25 Jan 2023 15:48:55 +0100 Subject: [PATCH 14/14] fix unit tests following changes in teal.slice --- tests/testthat/test-get_rcode.R | 2 +- tests/testthat/test-module_nested_tabs.R | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-get_rcode.R b/tests/testthat/test-get_rcode.R index ad2435c12f..bdcfcf0f39 100644 --- a/tests/testthat/test-get_rcode.R +++ b/tests/testthat/test-get_rcode.R @@ -40,7 +40,7 @@ testthat::test_that("get_rcode returns data-loading, filter-panel and chunks cod "MTCARS <- mtcars", "a <- 1" ) %in% - strsplit(get_rcode(datasets = datasets, chunks = ch), "\n")[[1]] + strsplit(shiny::isolate(get_rcode(datasets = datasets, chunks = ch)), "\n")[[1]] ) ) }) diff --git a/tests/testthat/test-module_nested_tabs.R b/tests/testthat/test-module_nested_tabs.R index 3f53d6fc24..4eecf4d400 100644 --- a/tests/testthat/test-module_nested_tabs.R +++ b/tests/testthat/test-module_nested_tabs.R @@ -408,7 +408,7 @@ testthat::test_that("calculate_hashes returns the hash of the non Filtered datas Species = c("setosa", "versicolor") ) ) - datasets$set_filter_state(state = fs) + shiny::isolate(datasets$set_filter_state(state = fs)) hashes <- calculate_hashes(datanames = c("iris"), datasets = datasets) testthat::expect_identical(hashes, list("iris" = "34844aba7bde36f5a34f6d8e39803508"))