#' ErrorControllerList
#'
#' Reactive R6Class that returns HTML according to a test function. Modules like
#' \code{\link{checked_text_input}} or \code{\link{observed_vector_input}}
#' provide a argument accepting an \code{\link{ErrorController}} or
#' ErrorControllerList that expands the module's default tests.
#'
#' @section Usage:
#' \preformatted{
#' error_controller <- shiny::isolate({
#' ErrorControllerList$new()$add_error_controller(
#' ErrorController$new(
#' fun = function(x) purrr::is_null(x),
#' ui_true = "x is NULL",
#' ui_false = "x is not NULL",
#' error = TRUE
#' )
#' )})
#' }
#'
#' @section Methods:
#' \describe{
#' \item{new()}{Initialize the error controller list.
#' }
#' \item{add_error_controller(error_controller)}{Add an \code{\link{ErrorController}}
#' to the error controller list.
#' }
#' \item{get_ui()}{Get the UI of all \code{\link{ErrorController}} as a list
#' ordered by the priority of the respective \code{\link{ErrorController}}.
#' }
#' \item{has_error()}{Returns \code{\link[base:logical]{TRUE}} if any of
#' the \code{\link{ErrorController}} has an error.
#' }
#' \item{set_value(value)}{Sets the value of all \code{\link{ErrorController}}.
#' }
#' }
#'
#' @name ErrorControllerList
NULL
#' @export
ErrorControllerList <- R6::R6Class(
classname = "ErrorControllerList",
public = list(
initialize = function() {
private$storage <- shiny::reactiveVal(list())
private$order <- shiny::reactive({
priority <- purrr::map_dbl(
private$storage(),
function(error_controller) {
error_controller$get_priority()
}
)
order(priority, decreasing = TRUE)
})
self
},
add_error_controller = function(error_controller) {
stopifnot("ErrorController" %in% class(error_controller))
storage <- private$storage()
storage[[length(storage) + 1]] <- error_controller
private$storage(storage)
self
},
get_ui = function(ordered = TRUE) {
if (ordered) {
storage <- private$storage()[private$order()]
} else {
storage <- private$storage()
}
purrr::map(storage, function(error_controller) {
error_controller$get_ui()
})
},
has_error = function() {
if (length(private$storage()) == 0) {
error <- FALSE
} else {
error <- any(purrr::map_lgl(private$storage(), function(error_controller) {
error_controller$has_error()
}))
}
error
},
set_value = function(value) {
purrr::walk(private$storage(), function(error_controller) {
error_controller$set_value(value)
})
self
}
),
private = list(
storage = NULL,
order = NULL
)
)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.