Open
Description
I was wondering whether anyone is using assertr in Shiny.
The idea was to notify users whenever an assertr chain fails by using Shiny's validate
mechanism.
This also keeps Shiny running, so users can adjust their choices consequently.
I wrote a new error function to do that: it basically prints the first line for each error.
I also wanted to deal with the non-Shiny case, falling back to a standard assertr
error function.
So actually it's an error function generator.
#' Generate an error function that gently informs the user in Shiny sessions.
#'
#' @param error_fallback Function to call if assertion fails, and Shiny is not running. Defaults to printing a summary of all errors.
#' @export
#' @importFrom shiny isRunning
#' @import assertr
#' @examples
#'
#' mtcars_without_am <- mtcars %>%
#' dplyr::select(-am)
#'
#' mtcars_without_am %>%
#' verify(has_all_names("am", "vs"), error_fun = error_validate_generator(error_report))
#'
error_validate_generator <- function(error_fallback = assertr::error_report) {
if (!shiny::isRunning()) {
return(error_fallback)
}
error_validate
}
#' Error function that gently informs the user in Shiny sessions
#' @importFrom purrr map_chr
#' @keywords internal
error_validate <- function(list_of_errors, data=NULL, ...){
# we are checking to see if there are any errors that
# are still attached to the data.frame
if(!is.null(data) && !is.null(attr(data, "assertr_errors"))) {
errors <- append(attr(data, "assertr_errors"), errors)
}
num_errors <- length(list_of_errors)
if (num_errors > 0) {
error_string <- c(
paste0('Data validation failed: ', num_errors, ' failures'),
paste0(' - ', purrr::map_chr(list_of_errors, 'message'))
)
} else {
error_string <- 'Data validation failed.'
}
# Return the error message to Shiny::validate call
shiny::validate(error_string, errorClass = 'assertr-validate')
invisible(NULL)
}
And here's a minimal app:
library(shiny)
library(dplyr)
library(assertr)
ui <- fluidPage(
headerPanel("Minimal app"),
tableOutput('tblOutput')
)
server <- function(input, output) {
output$tblOutput <- renderTable({
mtcars %>%
chain_start() %>%
verify(has_all_names('drat', 'hp', 'disp')) %>%
assert(within_bounds(60, Inf), hp) %>%
verify(drat < 4.5) %>%
verify(disp > 100) %>%
chain_end(error_fun = error_validate_generator(error_fallback = assertr::error_report))
})
}
# Runner
shinyApp(ui, server)
Does that look useful to anybody?
Is there a better approach?
Thanks!
Metadata
Metadata
Assignees
Labels
No labels