Skip to content

Feature request: assertr for Shiny #93

Open
@lgaborini

Description

@lgaborini

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

No one assigned

    Labels

    No labels
    No labels

    Projects

    No projects

    Milestone

    No milestone

    Relationships

    None yet

    Development

    No branches or pull requests

    Issue actions