✨ initial support for callback context

Author: Ryan Patrick Kyle

R/dash.R

@@ -208,7 +208,6 @@ Dash <- R6::R6Class(
 
       dash_update <- paste0(self$config$routes_pathname_prefix, "_dash-update-component")
       route$add_handler("post", dash_update, function(request, response, keys, ...) {
-
         request <- request_parse_json(request)
 
         if (!"output" %in% names(request$body)) {
@@ -255,6 +254,9 @@ Dash <- R6::R6Class(
           }
         }
 
+        # set the callback context associated with this invocation of the callback
+        private$callback_context_ <- setCallbackContext(request$body)
+          
         output_value <- getStackTrace(do.call(callback, callback_args),
                                       debug = private$debug,
                                       pruned_errors = private$pruned_errors)
@@ -463,8 +465,22 @@ Dash <- R6::R6Class(
           state=state,
           func=func
         )
+      
+      # # register the callback_context elements
+      # private$callback_context_[[paste(output$id, output$property, sep='.')]] <- list(
+      #   states=setCallbackContext(state),
+      #   triggered=list(),
+      #   inputs=getContextElements(inputs)
+      # )
     },
 
+    # ------------------------------------------------------------------------
+    # request and return callback context
+    # ------------------------------------------------------------------------    
+    callback_context = function() {
+      private$callback_context_
+    },
+    
     # ------------------------------------------------------------------------
     # convenient fiery wrappers
     # ------------------------------------------------------------------------
@@ -517,7 +533,10 @@ Dash <- R6::R6Class(
     # initialize flags for debug mode and stack pruning,
     debug = NULL,
     pruned_errors = NULL,
-    
+
+    # callback context
+    callback_context_ = NULL,   
+ 
     # fields for tracking HTML dependencies
     dependencies = list(),
     dependencies_user = list(),

R/utils.R

@@ -732,3 +732,33 @@ removeHandlers <- function(fnList) {
                       "withRestarts")
   return(fnList[!fnList %in% omittedStrings])
 }
+
+setCallbackContext <- function(callback_elements) {
+  states <- lapply(callback_elements$states, function(x) {
+    setNames(x$value, paste(x$id, x$property, sep="."))
+  })
+  
+  splitIdProp <- function(x) unlist(strsplit(x, split = "[.]"))
+  
+  triggered <- lapply(callback_elements$changedPropIds, 
+                      function(x) {
+                        input_id <- splitIdProp(x)[1]
+                        prop <- splitIdProp(x)[2]
+                        
+                        id_match <- vapply(callback_elements$inputs, function(x) x$id %in% input_id, logical(1))
+                        prop_match <- vapply(callback_elements$inputs, function(x) x$property %in% prop, logical(1))
+                        
+                        value <- sapply(callback_elements$inputs[id_match & prop_match], `[[`, "value")
+
+                        list(`prop_id` = x, `value` = value)
+                      }
+                      )
+  
+  inputs <- sapply(callback_elements$inputs, function(x) {
+    setNames(list(x$value), paste(x$id, x$property, sep="."))
+  })
+  
+  return(list(states=states, 
+              triggered=unlist(triggered, recursive=FALSE), 
+              inputs=inputs))
+}