Refactor DashR callbacks for increased parity with Dash for Python API

R/dash.R

@@ -245,7 +245,7 @@ Dash <- R6::R6Class(
 
         # get the callback associated with this particular output
         thisOutput <- with(request$body$output, paste(id, property, sep = "."))
-        callback <- private$callback_map[[thisOutput]][['user_function']]
+        callback <- private$callback_map[[thisOutput]][['func']]
         if (!length(callback)) stop_report("Couldn't find output component.")
         if (!is.function(callback)) {
           stop(sprintf("Couldn't find a callback function associated with '%s'", thisOutput))
@@ -298,6 +298,7 @@ Dash <- R6::R6Class(
     },
     layout_set = function(...) {
       private$layout <- if (is.function(..1)) ..1 else list(...)
+      private$layout_render()
     },
 
     # ------------------------------------------------------------------------
@@ -344,21 +345,18 @@ Dash <- R6::R6Class(
     # ------------------------------------------------------------------------
     # callback registration
     # ------------------------------------------------------------------------
-    callback = function(output = NULL, inputs = list(), state = list(), user_function) {
-      private$layout_render()
-
-      assert_valid_callbacks(output, inputs, state, user_function)
-
-      # set class attributes for compatibility with original DashR code
-      for (i in seq_along(inputs)) attr(inputs[[i]], 'class') <- c('dash_dependency', 'input')
-      for (i in seq_along(state)) attr(state[[i]], 'class') <- c('dash_dependency', 'input')
+    callback = function(output, params, func) {
+      assert_valid_callbacks(output, params, func)
+
+      inputs <- params[vapply(params, function(x) 'input' %in% attr(x, "class"), FUN.VALUE=logical(1))]
+      state <- params[vapply(params, function(x) 'state' %in% attr(x, "class"), FUN.VALUE=logical(1))]
 
       # register the callback_map
       private$callback_map[[paste(output$id, output$property, sep='.')]] <- list(
           output=output,
           inputs=inputs,
           state=state,
-          user_function=user_function
+          func=func
         )
     },
 

R/dependencies.R

@@ -38,15 +38,6 @@ state <- function(id = NULL, property = "value") {
   )
 }
 
-#' @rdname dependencies
-#' @export
-event <- function(id = NULL, property = "value") {
-  structure(
-    dependency(id, property),
-    class = c("dash_dependency", "event")
-  )
-}
-
 dependency <- function(id = NULL, property = NULL) {
   if (is.null(id)) stop("Must specify an id", call. = FALSE)
   list(

R/utils.R

@@ -7,14 +7,9 @@ is.fire <- function(x) inherits(x, "Fire")
 
 # dependencies
 is.dependency <- function(x) inherits(x, "dash_dependency")
-#is.output <- function(x) is.dependency(x) && inherits(x, "output")
-is.output <- function(x) return(x)
-#is.input <- function(x) is.dependency(x) && inherits(x, "input")
-is.input <- function(x) return(x)
-#is.state <- function(x) is.dependency(x) && inherits(x, "state")
-is.state <- function(x) return(x)
-#is.event <- function(x) is.dependency(x) && inherits(x, "event")
-is.event <- function(x) return(x)
+is.output <- function(x) inherits(x, "output")
+is.input <- function(x) inherits(x, "input")
+is.state <- function(x) inherits(x, "state")
 
 # components (TODO: this should be exported by dashRtranspile!)
 is.component <- function(x) inherits(x, "dash_component")
@@ -261,35 +256,38 @@ filter_null <- function(x) {
   x[!vapply(x, is.null, logical(1))]
 }
 
-assert_valid_callbacks <- function(output, inputs, state, user_function) {
+assert_valid_callbacks <- function(output, params, func) {
+  inputs <- params[vapply(params, function(x) 'input' %in% attr(x, "class"), FUN.VALUE=logical(1))]
+  state <- params[vapply(params, function(x) 'state' %in% attr(x, "class"), FUN.VALUE=logical(1))]
+
   # Assert that the component ID as passed is a string.
   if(!(is.character(output$id) & !grepl("^\\s*$", output$id) & !grepl("\\.", output$id))) {
     stop(sprintf("Callback IDs must be (non-empty) character strings that do not contain one or more dots/periods. Verify that the component ID is valid."), call. = FALSE)
   }
-
+  
   # Assert that user_function is a valid function
-  if(!(is.function(user_function))) {
+  if(!(is.function(func))) {
     stop(sprintf("The callback method's 'user_function' parameter requires a function as its argument. Verify that user_function is a valid, executable R function."), call. = FALSE)
   }
-
+  
   # Check if inputs are a nested list
   if(!(any(sapply(inputs, is.list)))) {
     stop(sprintf("Callback inputs should be a nested list, in which each element of the sublist represents a component ID and its properties."), call. = FALSE)
   }
-
+  
   # Check that input is not NULL
   if(is.null(inputs)) {
     stop(sprintf("The callback method requires that one or more properly formatted inputs are passed."), call. = FALSE)
   }
-
+  
   # Check that outputs are not inputs
   # https://github.com/plotly/dash/issues/323
   inputs_vs_outputs <- lapply(inputs, function(x) identical(x, output))
 
   if(TRUE %in% inputs_vs_outputs) {
     stop(sprintf("Circular input and output arguments were found. Please verify that callback outputs are not also input arguments."), call. = FALSE)
   }
-
+  
   # TO DO: check that components contain props
   TRUE
 }