From 18d0f45cf9a7462e46354e72780942876347b7a3 Mon Sep 17 00:00:00 2001 From: Joe Cheng Date: Wed, 7 May 2014 16:09:06 -0700 Subject: [PATCH 1/2] Refactoring/renaming of validation - validateInput renamed to validate - validateCondition renamed to need - Removed ability to provide "bare" conditions. It is still possible to fail validation silently by passing FALSE as the second argument to need() - Rather than using a two-element list to convey results, use a single result protocol; NULL is success, FALSE is silent failure, string is failure with message - Tweak "missing input" semantics, add tests --- NAMESPACE | 4 +- R/shinywrappers.R | 178 +++++++++++++++++++++++++------------- inst/staticdocs/index.r | 1 + inst/tests/test-utils.R | 37 ++++++++ inst/www/shared/shiny.css | 8 ++ man/validate.Rd | 96 ++++++++++++++++++++ man/validateInput.Rd | 65 -------------- 7 files changed, 263 insertions(+), 126 deletions(-) create mode 100644 man/validate.Rd delete mode 100644 man/validateInput.Rd diff --git a/NAMESPACE b/NAMESPACE index 2005ee00ac..daa35387b2 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -96,6 +96,7 @@ export(maskReactiveContext) export(navbarMenu) export(navbarPage) export(navlistPanel) +export(need) export(numericInput) export(observe) export(onReactiveDomainEnded) @@ -173,9 +174,8 @@ export(updateSelectizeInput) export(updateSliderInput) export(updateTabsetPanel) export(updateTextInput) -export(validateCondition) +export(validate) export(validateCssUnit) -export(validateInput) export(verbatimTextOutput) export(verticalLayout) export(wellPanel) diff --git a/R/shinywrappers.R b/R/shinywrappers.R index 0935e3dc73..72a28cf874 100644 --- a/R/shinywrappers.R +++ b/R/shinywrappers.R @@ -556,84 +556,144 @@ renderDataTable <- function(expr, options = NULL, searchDelay = 500, }) } -#' Check if input values satisfy the output rendering function +#' Validate input values and other conditions #' #' For an output rendering function (e.g. \code{\link{renderPlot}()}), you may -#' need to check certain input values before you can render the output. If the -#' input values do not satisfy the rendering function, a special type of error -#' can be emitted to indicate this special situation. If you need to show the -#' error message(s), you can use \code{validateCondition()} as the input to -#' \code{validateInput()}, otherwise \pkg{shiny} will silently stop processing -#' the input. -#' -#' For the sake of convenience, it is not strictly required that the condition -#' is a logical value, and you can use input values themselves as the testing -#' conditions, since there are a few common cases in which the input values are -#' often considered invalid, including \code{NULL}, \code{NA}, values of length -#' zero, and a special case for action buttons when they take values of 0 (i.e. -#' not clicked). If any of these values happen to be valid, you can explicitly -#' turn them to logical values. For example, if you allow \code{NA} but not -#' \code{NULL}, you can use the condition \code{!is.null(input$foo)}, because -#' \code{!is.null(NA) == TRUE}. -#' @param ... A list of arguments, and each argument takes either a logical -#' value or an object returned by \code{validateCondition()}. When an argument -#' takes a logical value, the value is the condition on which the rendering -#' function should stop (the condition normally returns \code{TRUE} or -#' \code{FALSE}, and this function stops when the condition is \code{FALSE}; -#' see Details). +#' need to check that certain input values are available and valid before you +#' can render the output. \code{validate} gives you a convenient mechanism for +#' doing so. +#' +#' The \code{validate} function takes any number of (unnamed) arguments, each of +#' which represents a condition to test. If any of the conditions represent +#' failure, then a special type of error is signaled which stops execution. If +#' this error is not handled by application-specific code, it is displayed to +#' the user by Shiny. +#' +#' An easy way to provide arguments to \code{validate} is to use the \code{need} +#' function, which takes an expression and a string; if the expression is +#' considered a failure, then the string will be used as the error message. The +#' \code{need} function considers its expression to be a failure if it is any of +#' the following: +#' +#' \itemize{ +#' \item{\code{FALSE}} +#' \item{\code{NULL}} +#' \item{\code{""}} +#' \item{An empty atomic vector} +#' \item{An atomic vector that contains only missing values} +#' \item{A logical vector that contains all \code{FALSE} or missing values} +#' \item{An object of class \code{"try-error"}} +#' \item{A value that represents an unclicked \code{\link{actionButton}}} +#' } +#' +#' If any of these values happen to be valid, you can explicitly turn them to +#' logical values. For example, if you allow \code{NA} but not \code{NULL}, you +#' can use the condition \code{!is.null(input$foo)}, because \code{!is.null(NA) +#' == TRUE}. +#' +#' If you need validation logic that differs significantly from \code{need}, you +#' can create other validation test functions. A passing test should return +#' \code{NULL}. A failing test should return an error message as a +#' single-element character vector, or if the failure should happen silently, +#' \code{FALSE}. +#' +#' Because validation failure is signaled as an error, you can use +#' \code{validate} in reactive expressions, and validation failures will +#' automatically propagate to outputs that use the reactive expression. In +#' other words, if reactive expression \code{a} needs \code{input$x}, and two +#' outputs use \code{a} (and thus depend indirectly on \code{input$x}), it's +#' not necessary for the outputs to validate \code{input$x} explicitly, as long +#' as \code{a} does validate it. +#' +#' @param ... A list of tests. Each test should equal \code{NULL} for success, +#' \code{FALSE} for silent failure, or a string for failure with an error +#' message. +#' @param errorClass A CSS class to apply. #' @export #' @examples #' # in ui.R #' fluidPage( -#' actionButton('in1', 'Go!'), -#' checkboxGroupInput('in2', 'Check some letters', choices = head(LETTERS)), -#' selectizeInput('in3', 'Select a state', choices = state.name), +#' checkboxGroupInput('in1', 'Check some letters', choices = head(LETTERS)), +#' selectizeInput('in2', 'Select a state', choices = state.name), #' plotOutput('plot') #' ) #' #' # in server.R #' function(input, output) { #' output$plot <- renderPlot({ -#' validateInput( -#' input$in1, # ensure the button has been clicked -#' validateCondition(input$in2, 'Check at least one letter!'), -#' validateCondition(input$in3 == '', 'Please choose a state.') +#' validate( +#' need(input$in1, 'Check at least one letter!'), +#' need(input$in2 == '', 'Please choose a state.') #' ) -#' plot(1:10, main = paste(c(input$bar, input$foo), collapse = ', ')) +#' plot(1:10, main = paste(c(input$in1, input$in2), collapse = ', ')) #' }) #' } -validateInput <- function(...) { - msg <- character(0) - fail <- FALSE - for (i in list(...)) { - verify <- testInvalidInput(i) - if (verify$invalid) { - fail <- TRUE - if (verify$condition) msg <- c(msg, i[[2]]) - } - } - if (fail) { - msg <- paste(unlist(msg), collapse = '\n') - stopWithCondition(msg, 'validation') - } +validate <- function(..., errorClass = character(0)) { + results <- sapply(list(...), function(x) { + # Detect NULL or NA + if (is.null(x) || length(x) == 0 || all(is.na(x))) + return(NA_character_) + # Detect all empty strings + else if (is.character(x) && all(!nzchar(x))) + return(NA_character_) + else if (identical(x, FALSE)) + return("") + else + return(paste(as.character(x), collapse = "\n")) + }) + + results <- na.omit(results) + if (length(results) == 0) + return(invisible()) + + # There may be empty strings remaining; these are message-less failures that + # started as FALSE + results <- results[nzchar(results)] + + stopWithCondition(paste(results, collapse="\n"), c("validation", errorClass)) } -#' @param condition A condition to be validated. -#' @param message A character string as the error message if the condition is -#' not satisfied. + +#' @param expr An expression to test. The condition will pass if the expression +#' meets the conditions spelled out in Details. +#' @param message A message to convey to the user if the validation condition is +#' not met. If no message is provided, one will be created using \code{label}. +#' To fail with no message, use \code{FALSE} for the message. +#' @param label A human-readable name for the field that may be missing. This +#' parameter is not needed if \code{message} is provided, but must be provided +#' otherwise. #' @export -#' @rdname validateInput -validateCondition <- function(condition, message) { - structure(list(condition, message), class = 'shinyValidationCondition') -} +#' @rdname validate +need <- function(expr, message = paste(label, "must be provided"), label) { -testInvalidInput <- function(x) { - cond <- inherits(x, 'shinyValidationCondition') - # list(condition = ?, message = ?) - if (cond) x <- x[[1]] + force(message) # Fail fast on message/label both being missing + + if (!isTruthy(expr)) + return(message) + else + return(invisible(NULL)) +} - val <- identical(x, FALSE) || length(x) == 0 || (length(x) == 1 && is.na(x)) || - (inherits(x, 'shinyActionButtonValue') && x == 0) - list(condition = cond, invalid = val) +isTruthy <- function(x) { + if (inherits(x, 'try-error')) + return(FALSE) + + if (!is.atomic(x)) + return(TRUE) + + if (is.null(x)) + return(FALSE) + if (length(x) == 0) + return(FALSE) + if (all(is.na(x))) + return(FALSE) + if (is.character(x) && !any(nzchar(na.omit(x)))) + return(FALSE) + if (inherits(x, 'shinyActionButtonValue') && x == 0) + return(FALSE) + if (is.logical(x) && !any(na.omit(x))) + return(FALSE) + + return(TRUE) } # add class(es) to the error condition, which will be used as names of CSS diff --git a/inst/staticdocs/index.r b/inst/staticdocs/index.r index cfc597928d..610954c052 100644 --- a/inst/staticdocs/index.r +++ b/inst/staticdocs/index.r @@ -142,6 +142,7 @@ sd_section("Extending Shiny", sd_section("Utility functions", "Miscellaneous utilities that may be useful to advanced users or when extending Shiny.", c( + "validate", "exprToFunction", "installExprFunction", "parseQueryString", diff --git a/inst/tests/test-utils.R b/inst/tests/test-utils.R index 2c946becad..72f06f616d 100644 --- a/inst/tests/test-utils.R +++ b/inst/tests/test-utils.R @@ -47,3 +47,40 @@ test_that("Setting the private seed explicitly results in identical values", { expect_identical(id7, id8) }) + +test_that("need() works as expected", { + + # These are all falsy + + expect_false(need(FALSE, FALSE)) + expect_false(need(NULL, FALSE)) + expect_false(need("", FALSE)) + + expect_false(need(character(0), FALSE)) + expect_false(need(logical(0), FALSE)) + expect_false(need(numeric(0), FALSE)) + expect_false(need(integer(0), FALSE)) + expect_false(need(complex(0), FALSE)) + expect_false(need(matrix(), FALSE)) + + expect_false(need(NA, FALSE)) + expect_false(need(NA_integer_, FALSE)) + expect_false(need(NA_real_, FALSE)) + expect_false(need(NA_complex_, FALSE)) + expect_false(need(NA_character_, FALSE)) + + expect_false(need(c(NA, NA, FALSE), FALSE)) + expect_false(need(c(FALSE), FALSE)) + + expect_false(need(try(stop("boom"), silent = TRUE), FALSE)) + + # These are all truthy + + expect_null(need(0, FALSE)) + expect_null(need(1:10, FALSE)) + expect_null(need(LETTERS, FALSE)) + expect_null(need("NA", FALSE)) + expect_null(need(TRUE, FALSE)) + expect_null(need(c(NA, NA, TRUE), FALSE)) + expect_null(need(c(FALSE, FALSE, TRUE), FALSE)) +}) diff --git a/inst/www/shared/shiny.css b/inst/www/shared/shiny.css index 74dce72f07..6176fd34b5 100644 --- a/inst/www/shared/shiny.css +++ b/inst/www/shared/shiny.css @@ -13,11 +13,19 @@ table.data td[align=right] { .shiny-output-error { color: red; + white-space: pre-wrap; } .shiny-output-error:before { content: 'Error: '; font-weight: bold; } +.shiny-output-error-validation { + color: #888; +} +.shiny-output-error-validation:before { + content: ''; + font-weight: inherit; +} .jslider { /* Fix jslider running into the control above it */ diff --git a/man/validate.Rd b/man/validate.Rd new file mode 100644 index 0000000000..058f85e48e --- /dev/null +++ b/man/validate.Rd @@ -0,0 +1,96 @@ +% Generated by roxygen2 (4.0.0): do not edit by hand +\name{validate} +\alias{need} +\alias{validate} +\title{Validate input values and other conditions} +\usage{ +validate(..., errorClass = character(0)) + +need(expr, message = paste(label, "must be provided"), label) +} +\arguments{ +\item{...}{A list of tests. Each test should equal \code{NULL} for success, +\code{FALSE} for silent failure, or a string for failure with an error +message.} + +\item{errorClass}{A CSS class to apply.} + +\item{expr}{An expression to test. The condition will pass if the expression +meets the conditions spelled out in Details.} + +\item{message}{A message to convey to the user if the validation condition is +not met. If no message is provided, one will be created using \code{label}. +To fail with no message, use \code{FALSE} for the message.} + +\item{label}{A human-readable name for the field that may be missing. This +parameter is not needed if \code{message} is provided, but must be provided +otherwise.} +} +\description{ +For an output rendering function (e.g. \code{\link{renderPlot}()}), you may +need to check that certain input values are available and valid before you +can render the output. \code{validate} gives you a convenient mechanism for +doing so. +} +\details{ +The \code{validate} function takes any number of (unnamed) arguments, each of +which represents a condition to test. If any of the conditions represent +failure, then a special type of error is signaled which stops execution. If +this error is not handled by application-specific code, it is displayed to +the user by Shiny. + +An easy way to provide arguments to \code{validate} is to use the \code{need} +function, which takes an expression and a string; if the expression is +considered a failure, then the string will be used as the error message. The +\code{need} function considers its expression to be a failure if it is any of +the following: + +\itemize{ + \item{\code{FALSE}} + \item{\code{NULL}} + \item{\code{""}} + \item{An empty atomic vector} + \item{An atomic vector that contains only missing values} + \item{A logical vector that contains all \code{FALSE} or missing values} + \item{An object of class \code{"try-error"}} + \item{A value that represents an unclicked \code{\link{actionButton}}} +} + +If any of these values happen to be valid, you can explicitly turn them to +logical values. For example, if you allow \code{NA} but not \code{NULL}, you +can use the condition \code{!is.null(input$foo)}, because \code{!is.null(NA) +== TRUE}. + +If you need validation logic that differs from \code{need}, you can create +other functions. A passing test should return \code{NULL}. A failing test +should return an error message as a single-element character vector, or if +the failure should happen silently, \code{FALSE}. + +Because validation failure is signaled as an error, you can use +\code{validate} in reactive expressions, and validation failures will +automatically propagate to outputs that use the reactive expression. In +other words, if reactive expression \code{a} needs \code{input$x}, and two +outputs use \code{a} (and thus depend indirectly on \code{input$x}), it's +not necessary for the outputs to validate \code{input$x} explicitly, as long +as \code{a} does validate it. +} +\examples{ +# in ui.R +fluidPage( + checkboxGroupInput('in1', 'Check some letters', choices = head(LETTERS)), + selectizeInput('in2', 'Select a state', choices = state.name), + plotOutput('plot') +) + +# in server.R +function(input, output) { + output$plot <- renderPlot({ + validate( + need(input$in1, 'Check at least one letter!'), + need(input$in2 == '', 'Please choose a state.') + ) + plot(1:10, main = paste(c(input$in1, input$in2), collapse = ', ')) + }) +} +} + diff --git a/man/validateInput.Rd b/man/validateInput.Rd deleted file mode 100644 index c2d3da7164..0000000000 --- a/man/validateInput.Rd +++ /dev/null @@ -1,65 +0,0 @@ -% Generated by roxygen2 (4.0.0): do not edit by hand -\name{validateInput} -\alias{validateCondition} -\alias{validateInput} -\title{Check if input values satisfy the output rendering function} -\usage{ -validateInput(...) - -validateCondition(condition, message) -} -\arguments{ -\item{...}{A list of arguments, and each argument takes either a logical -value or an object returned by \code{validateCondition()}. When an argument -takes a logical value, the value is the condition on which the rendering -function should stop (the condition normally returns \code{TRUE} or -\code{FALSE}, and this function stops when the condition is \code{FALSE}; -see Details).} - -\item{condition}{A condition to be validated.} - -\item{message}{A character string as the error message if the condition is -not satisfied.} -} -\description{ -For an output rendering function (e.g. \code{\link{renderPlot}()}), you may -need to check certain input values before you can render the output. If the -input values do not satisfy the rendering function, a special type of error -can be emitted to indicate this special situation. If you need to show the -error message(s), you can use \code{validateCondition()} as the input to -\code{validateInput()}, otherwise \pkg{shiny} will silently stop processing -the input. -} -\details{ -For the sake of convenience, it is not strictly required that the condition -is a logical value, and you can use input values themselves as the testing -conditions, since there are a few common cases in which the input values are -often considered invalid, including \code{NULL}, \code{NA}, values of length -zero, and a special case for action buttons when they take values of 0 (i.e. -not clicked). If any of these values happen to be valid, you can explicitly -turn them to logical values. For example, if you allow \code{NA} but not -\code{NULL}, you can use the condition \code{!is.null(input$foo)}, because -\code{!is.null(NA) == TRUE}. -} -\examples{ -# in ui.R -fluidPage( - actionButton('in1', 'Go!'), - checkboxGroupInput('in2', 'Check some letters', choices = head(LETTERS)), - selectizeInput('in3', 'Select a state', choices = state.name), - plotOutput('plot') -) - -# in server.R -function(input, output) { - output$plot <- renderPlot({ - validateInput( - input$in1, # ensure the button has been clicked - validateCondition(input$in2, 'Check at least one letter!'), - validateCondition(input$in3 == '', 'Please choose a state.') - ) - plot(1:10, main = paste(c(input$bar, input$foo), collapse = ', ')) - }) -} -} - From ca27a9e31a5efc7d40e3620293295e614b40ee9b Mon Sep 17 00:00:00 2001 From: Joe Cheng Date: Wed, 7 May 2014 16:19:19 -0700 Subject: [PATCH 2/2] Validation refactoring - Move validation logic from shinywrappers.R to utils.R - Don't coerce validation results; fail if not FALSE, NULL, or character - Reverse order of stopWithCondition args --- R/shinywrappers.R | 149 ---------------------------------------------- R/utils.R | 149 ++++++++++++++++++++++++++++++++++++++++++++++ man/validate.Rd | 9 +-- 3 files changed, 154 insertions(+), 153 deletions(-) diff --git a/R/shinywrappers.R b/R/shinywrappers.R index 72a28cf874..a6a4358a59 100644 --- a/R/shinywrappers.R +++ b/R/shinywrappers.R @@ -556,155 +556,6 @@ renderDataTable <- function(expr, options = NULL, searchDelay = 500, }) } -#' Validate input values and other conditions -#' -#' For an output rendering function (e.g. \code{\link{renderPlot}()}), you may -#' need to check that certain input values are available and valid before you -#' can render the output. \code{validate} gives you a convenient mechanism for -#' doing so. -#' -#' The \code{validate} function takes any number of (unnamed) arguments, each of -#' which represents a condition to test. If any of the conditions represent -#' failure, then a special type of error is signaled which stops execution. If -#' this error is not handled by application-specific code, it is displayed to -#' the user by Shiny. -#' -#' An easy way to provide arguments to \code{validate} is to use the \code{need} -#' function, which takes an expression and a string; if the expression is -#' considered a failure, then the string will be used as the error message. The -#' \code{need} function considers its expression to be a failure if it is any of -#' the following: -#' -#' \itemize{ -#' \item{\code{FALSE}} -#' \item{\code{NULL}} -#' \item{\code{""}} -#' \item{An empty atomic vector} -#' \item{An atomic vector that contains only missing values} -#' \item{A logical vector that contains all \code{FALSE} or missing values} -#' \item{An object of class \code{"try-error"}} -#' \item{A value that represents an unclicked \code{\link{actionButton}}} -#' } -#' -#' If any of these values happen to be valid, you can explicitly turn them to -#' logical values. For example, if you allow \code{NA} but not \code{NULL}, you -#' can use the condition \code{!is.null(input$foo)}, because \code{!is.null(NA) -#' == TRUE}. -#' -#' If you need validation logic that differs significantly from \code{need}, you -#' can create other validation test functions. A passing test should return -#' \code{NULL}. A failing test should return an error message as a -#' single-element character vector, or if the failure should happen silently, -#' \code{FALSE}. -#' -#' Because validation failure is signaled as an error, you can use -#' \code{validate} in reactive expressions, and validation failures will -#' automatically propagate to outputs that use the reactive expression. In -#' other words, if reactive expression \code{a} needs \code{input$x}, and two -#' outputs use \code{a} (and thus depend indirectly on \code{input$x}), it's -#' not necessary for the outputs to validate \code{input$x} explicitly, as long -#' as \code{a} does validate it. -#' -#' @param ... A list of tests. Each test should equal \code{NULL} for success, -#' \code{FALSE} for silent failure, or a string for failure with an error -#' message. -#' @param errorClass A CSS class to apply. -#' @export -#' @examples -#' # in ui.R -#' fluidPage( -#' checkboxGroupInput('in1', 'Check some letters', choices = head(LETTERS)), -#' selectizeInput('in2', 'Select a state', choices = state.name), -#' plotOutput('plot') -#' ) -#' -#' # in server.R -#' function(input, output) { -#' output$plot <- renderPlot({ -#' validate( -#' need(input$in1, 'Check at least one letter!'), -#' need(input$in2 == '', 'Please choose a state.') -#' ) -#' plot(1:10, main = paste(c(input$in1, input$in2), collapse = ', ')) -#' }) -#' } -validate <- function(..., errorClass = character(0)) { - results <- sapply(list(...), function(x) { - # Detect NULL or NA - if (is.null(x) || length(x) == 0 || all(is.na(x))) - return(NA_character_) - # Detect all empty strings - else if (is.character(x) && all(!nzchar(x))) - return(NA_character_) - else if (identical(x, FALSE)) - return("") - else - return(paste(as.character(x), collapse = "\n")) - }) - - results <- na.omit(results) - if (length(results) == 0) - return(invisible()) - - # There may be empty strings remaining; these are message-less failures that - # started as FALSE - results <- results[nzchar(results)] - - stopWithCondition(paste(results, collapse="\n"), c("validation", errorClass)) -} - -#' @param expr An expression to test. The condition will pass if the expression -#' meets the conditions spelled out in Details. -#' @param message A message to convey to the user if the validation condition is -#' not met. If no message is provided, one will be created using \code{label}. -#' To fail with no message, use \code{FALSE} for the message. -#' @param label A human-readable name for the field that may be missing. This -#' parameter is not needed if \code{message} is provided, but must be provided -#' otherwise. -#' @export -#' @rdname validate -need <- function(expr, message = paste(label, "must be provided"), label) { - - force(message) # Fail fast on message/label both being missing - - if (!isTruthy(expr)) - return(message) - else - return(invisible(NULL)) -} - -isTruthy <- function(x) { - if (inherits(x, 'try-error')) - return(FALSE) - - if (!is.atomic(x)) - return(TRUE) - - if (is.null(x)) - return(FALSE) - if (length(x) == 0) - return(FALSE) - if (all(is.na(x))) - return(FALSE) - if (is.character(x) && !any(nzchar(na.omit(x)))) - return(FALSE) - if (inherits(x, 'shinyActionButtonValue') && x == 0) - return(FALSE) - if (is.logical(x) && !any(na.omit(x))) - return(FALSE) - - return(TRUE) -} - -# add class(es) to the error condition, which will be used as names of CSS -# classes, e.g. shiny-output-error shiny-output-error-validation -stopWithCondition <- function(message, class) { - cond <- structure( - list(message = message), - class = c('error', 'condition', class) - ) - stop(cond) -} # Deprecated functions ------------------------------------------------------ diff --git a/R/utils.R b/R/utils.R index 1ff2de5402..31de599d05 100644 --- a/R/utils.R +++ b/R/utils.R @@ -747,3 +747,152 @@ columnToRowData <- function(data) { ) ) } + +#' Validate input values and other conditions +#' +#' For an output rendering function (e.g. \code{\link{renderPlot}()}), you may +#' need to check that certain input values are available and valid before you +#' can render the output. \code{validate} gives you a convenient mechanism for +#' doing so. +#' +#' The \code{validate} function takes any number of (unnamed) arguments, each of +#' which represents a condition to test. If any of the conditions represent +#' failure, then a special type of error is signaled which stops execution. If +#' this error is not handled by application-specific code, it is displayed to +#' the user by Shiny. +#' +#' An easy way to provide arguments to \code{validate} is to use the \code{need} +#' function, which takes an expression and a string; if the expression is +#' considered a failure, then the string will be used as the error message. The +#' \code{need} function considers its expression to be a failure if it is any of +#' the following: +#' +#' \itemize{ +#' \item{\code{FALSE}} +#' \item{\code{NULL}} +#' \item{\code{""}} +#' \item{An empty atomic vector} +#' \item{An atomic vector that contains only missing values} +#' \item{A logical vector that contains all \code{FALSE} or missing values} +#' \item{An object of class \code{"try-error"}} +#' \item{A value that represents an unclicked \code{\link{actionButton}}} +#' } +#' +#' If any of these values happen to be valid, you can explicitly turn them to +#' logical values. For example, if you allow \code{NA} but not \code{NULL}, you +#' can use the condition \code{!is.null(input$foo)}, because \code{!is.null(NA) +#' == TRUE}. +#' +#' If you need validation logic that differs significantly from \code{need}, you +#' can create other validation test functions. A passing test should return +#' \code{NULL}. A failing test should return an error message as a +#' single-element character vector, or if the failure should happen silently, +#' \code{FALSE}. +#' +#' Because validation failure is signaled as an error, you can use +#' \code{validate} in reactive expressions, and validation failures will +#' automatically propagate to outputs that use the reactive expression. In +#' other words, if reactive expression \code{a} needs \code{input$x}, and two +#' outputs use \code{a} (and thus depend indirectly on \code{input$x}), it's +#' not necessary for the outputs to validate \code{input$x} explicitly, as long +#' as \code{a} does validate it. +#' +#' @param ... A list of tests. Each test should equal \code{NULL} for success, +#' \code{FALSE} for silent failure, or a string for failure with an error +#' message. +#' @param errorClass A CSS class to apply. +#' @export +#' @examples +#' # in ui.R +#' fluidPage( +#' checkboxGroupInput('in1', 'Check some letters', choices = head(LETTERS)), +#' selectizeInput('in2', 'Select a state', choices = state.name), +#' plotOutput('plot') +#' ) +#' +#' # in server.R +#' function(input, output) { +#' output$plot <- renderPlot({ +#' validate( +#' need(input$in1, 'Check at least one letter!'), +#' need(input$in2 == '', 'Please choose a state.') +#' ) +#' plot(1:10, main = paste(c(input$in1, input$in2), collapse = ', ')) +#' }) +#' } +validate <- function(..., errorClass = character(0)) { + results <- sapply(list(...), function(x) { + # Detect NULL or NA + if (is.null(x)) + return(NA_character_) + else if (identical(x, FALSE)) + return("") + else if (is.character(x)) + return(paste(as.character(x), collapse = "\n")) + else + stop("Unexpected validation result: ", as.character(x)) + }) + + results <- na.omit(results) + if (length(results) == 0) + return(invisible()) + + # There may be empty strings remaining; these are message-less failures that + # started as FALSE + results <- results[nzchar(results)] + + stopWithCondition(c("validation", errorClass), paste(results, collapse="\n")) +} + +#' @param expr An expression to test. The condition will pass if the expression +#' meets the conditions spelled out in Details. +#' @param message A message to convey to the user if the validation condition is +#' not met. If no message is provided, one will be created using \code{label}. +#' To fail with no message, use \code{FALSE} for the message. +#' @param label A human-readable name for the field that may be missing. This +#' parameter is not needed if \code{message} is provided, but must be provided +#' otherwise. +#' @export +#' @rdname validate +need <- function(expr, message = paste(label, "must be provided"), label) { + + force(message) # Fail fast on message/label both being missing + + if (!isTruthy(expr)) + return(message) + else + return(invisible(NULL)) +} + +isTruthy <- function(x) { + if (inherits(x, 'try-error')) + return(FALSE) + + if (!is.atomic(x)) + return(TRUE) + + if (is.null(x)) + return(FALSE) + if (length(x) == 0) + return(FALSE) + if (all(is.na(x))) + return(FALSE) + if (is.character(x) && !any(nzchar(na.omit(x)))) + return(FALSE) + if (inherits(x, 'shinyActionButtonValue') && x == 0) + return(FALSE) + if (is.logical(x) && !any(na.omit(x))) + return(FALSE) + + return(TRUE) +} + +# add class(es) to the error condition, which will be used as names of CSS +# classes, e.g. shiny-output-error shiny-output-error-validation +stopWithCondition <- function(class, message) { + cond <- structure( + list(message = message), + class = c('error', 'condition', class) + ) + stop(cond) +} diff --git a/man/validate.Rd b/man/validate.Rd index 058f85e48e..9d6b02a028 100644 --- a/man/validate.Rd +++ b/man/validate.Rd @@ -61,10 +61,11 @@ logical values. For example, if you allow \code{NA} but not \code{NULL}, you can use the condition \code{!is.null(input$foo)}, because \code{!is.null(NA) == TRUE}. -If you need validation logic that differs from \code{need}, you can create -other functions. A passing test should return \code{NULL}. A failing test -should return an error message as a single-element character vector, or if -the failure should happen silently, \code{FALSE}. +If you need validation logic that differs significantly from \code{need}, you +can create other validation test functions. A passing test should return +\code{NULL}. A failing test should return an error message as a +single-element character vector, or if the failure should happen silently, +\code{FALSE}. Because validation failure is signaled as an error, you can use \code{validate} in reactive expressions, and validation failures will