feat(mock-session): Add removeInputs method

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`

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)
   )
 }
 

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))

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{<div class="r6-fields">}}
@@ -95,6 +104,7 @@ user. Always \code{NULL} for a \code{MockShinySesion}.}
 \item \href{#method-MockShinySession-cycleStartAction}{\code{MockShinySession$cycleStartAction()}}
 \item \href{#method-MockShinySession-fileUrl}{\code{MockShinySession$fileUrl()}}
 \item \href{#method-MockShinySession-setInputs}{\code{MockShinySession$setInputs()}}
+\item \href{#method-MockShinySession-removeInputs}{\code{MockShinySession$removeInputs()}}
 \item \href{#method-MockShinySession-.scheduleTask}{\code{MockShinySession$.scheduleTask()}}
 \item \href{#method-MockShinySession-elapse}{\code{MockShinySession$elapse()}}
 \item \href{#method-MockShinySession-.now}{\code{MockShinySession$.now()}}
@@ -279,6 +289,35 @@ session$setInputs(x=1, y=2)
 
 }
 
+}
+\if{html}{\out{<hr>}}
+\if{html}{\out{<a id="method-MockShinySession-removeInputs"></a>}}
+\if{latex}{\out{\hypertarget{method-MockShinySession-removeInputs}{}}}
+\subsection{Method \code{removeInputs()}}{
+Removes inputs from the \code{session$inputs} object and flushes
+the reactives.
+\subsection{Usage}{
+\if{html}{\out{<div class="r">}}\preformatted{MockShinySession$removeInputs(inputIds)}\if{html}{\out{</div>}}
+}
+
+\subsection{Arguments}{
+\if{html}{\out{<div class="arguments">}}
+\describe{
+\item{\code{inputIds}}{Character vector of input ids to remove.}
+}
+\if{html}{\out{</div>}}
+}
+\subsection{Examples}{
+\if{html}{\out{<div class="r example copy">}}
+\preformatted{\dontrun{
+session$setInputs(x=1, y=2)
+session$removeInputs("x")
+}
+}
+\if{html}{\out{</div>}}
+
+}
+
 }
 \if{html}{\out{<hr>}}
 \if{html}{\out{<a id="method-MockShinySession-.scheduleTask"></a>}}