diff --git a/R/mock-session.R b/R/mock-session.R index a888f0eea..0d81960b2 100644 --- a/R/mock-session.R +++ b/R/mock-session.R @@ -369,6 +369,29 @@ MockShinySession <- R6Class( }) private$flush() }, + + #' @description Removes inputs from the `session$inputs` object and flushes + #' the reactives. + #' @param inputIds Character vector of input ids to remove. + #' @examples + #' \dontrun{ + #' session$setInputs(x=1, y=2) + #' session$removeInputs("x") + #' } + removeInputs = function(inputIds) { + is_clientdata <- grepl("^.clientdata_", inputIds) + if (any(is_clientdata)) { + abort( + "Cannot remove clientData inputs: ", + paste(inputIds[is_clientdata], collapse = ", ") + ) + } + + for (inputId in inputIds) { + private$.input$remove(inputId) + } + private$flush() + }, #' @description An internal method which shouldn't be used by others. #' Schedules `callback` for execution after some number of `millis` diff --git a/R/reactives.R b/R/reactives.R index a5f7772b6..e61a67f11 100644 --- a/R/reactives.R +++ b/R/reactives.R @@ -398,8 +398,6 @@ ReactiveValues <- R6Class( # invalidate all deps of `key` domain <- getDefaultReactiveDomain() - hidden <- substr(key, 1, 1) == "." - key_exists <- .values$containsKey(key) if (key_exists && !isTRUE(force) && .dedupe && identical(.values$get(key), value)) { @@ -420,26 +418,15 @@ ReactiveValues <- R6Class( .dependents$get(key)$invalidate() } - # only invalidate if there are deps - if (!key_exists && isTRUE(.hasRetrieved$names)) { - rLog$valueChangeNames(.reactId, .values$keys(), domain) - .namesDeps$invalidate() + # invalidate names() or toList() if needed + if (!key_exists) { + private$invalidateNames(domain) } - if (hidden) { - if (isTRUE(.hasRetrieved$asListAll)) { - rLog$valueChangeAsListAll(.reactId, .values$values(), domain) - .allValuesDeps$invalidate() - } - } else { - if (isTRUE(.hasRetrieved$asList)) { - react_vals <- .values$values() - react_vals <- react_vals[!grepl("^\\.", base::names(react_vals))] - # leave as is. both object would be registered to the listening object - rLog$valueChangeAsList(.reactId, react_vals, domain) - .valuesDeps$invalidate() - } - } + private$invalidateAsListAny( + all.names = substr(key, 1, 1) == ".", + domain = domain + ) invisible() }, @@ -451,6 +438,21 @@ ReactiveValues <- R6Class( }) }, + remove = function(key) { + stopifnot(rlang::is_string(key)) + + if (!self$.values$containsKey(key)) { + return(invisible()) + } + + value <- self$.values$get(key) + self$.values$remove(key) + self$.nameOrder <- setdiff(self$.nameOrder, key) + private$invalidateNames() + private$invalidateAsListAny(all.names = substr(key, 1, 1) == ".") + invisible(value) + }, + names = function() { if (!isTRUE(.hasRetrieved$names)) { domain <- getDefaultReactiveDomain() @@ -529,7 +531,47 @@ ReactiveValues <- R6Class( return(listValue) } + ), + private = list( + invalidateNames = function(domain = getDefaultReactiveDomain()) { + if (!isTRUE(self$.hasRetrieved$names)) { + return(invisible()) + } + rLog$valueChangeNames(self$.reactId, self$.values$keys(), domain) + self$.namesDeps$invalidate() + }, + + invalidateAsListAny = function( + all.names, + domain = getDefaultReactiveDomain() + ) { + if (isTRUE(all.names)) { + private$invalidateAsListAll(domain) + } else { + private$invalidateAsList(domain) + } + }, + + invalidateAsListAll = function(domain = getDefaultReactiveDomain()) { + if (!isTRUE(self$.hasRetrieved$asListAll)) { + return(invisible()) + } + + rLog$valueChangeAsListAll(self$.reactId, self$.values$values(), domain) + self$.allValuesDeps$invalidate() + }, + + invalidateAsList = function(domain = getDefaultReactiveDomain()) { + if (!isTRUE(self$.hasRetrieved$asList)) { + return(invisible()) + } + react_vals <- self$.values$values() + react_vals <- react_vals[!grepl("^\\.", base::names(react_vals))] + # leave as is. both object would be registered to the listening object + rLog$valueChangeAsList(self$.reactId, react_vals, domain) + self$.valuesDeps$invalidate() + } ) ) @@ -599,14 +641,15 @@ checkName <- function(x) { # @param ns A namespace function (either `identity` or `NS(namespace)`) .createReactiveValues <- function(values = NULL, readonly = FALSE, ns = identity) { - + structure( list( impl = values, readonly = readonly, ns = ns ), - class='reactivevalues' + class='reactivevalues', + remove = function(key) values$remove(key) ) } diff --git a/R/shiny.R b/R/shiny.R index c5e1eadc1..c0aea7f87 100644 --- a/R/shiny.R +++ b/R/shiny.R @@ -2159,6 +2159,19 @@ ShinySession <- R6Class( self$cycleStartAction(doManageInputs) } }, + removeInputs = function(inputIds) { + is_clientdata <- grepl("^.clientdata_", inputIds) + if (any(is_clientdata)) { + abort( + "Cannot remove clientData inputs: ", + paste(inputIds[is_clientdata], collapse = ", ") + ) + } + + for (inputId in inputIds) { + private$.input$remove(inputId) + } + }, outputOptions = function(name, ...) { # If no name supplied, return the list of options for all outputs if (is.null(name)) diff --git a/man/MockShinySession.Rd b/man/MockShinySession.Rd index f83eaa2c2..82f526de8 100644 --- a/man/MockShinySession.Rd +++ b/man/MockShinySession.Rd @@ -28,6 +28,15 @@ of \code{\link[=testServer]{testServer()}}. \dontrun{ session$setInputs(x=1, y=2) } + +## ------------------------------------------------ +## Method `MockShinySession$removeInputs` +## ------------------------------------------------ + +\dontrun{ +session$setInputs(x=1, y=2) +session$removeInputs("x") +} } \section{Public fields}{ \if{html}{\out{