Implement support for clientside callbacks in Dash for R

NAMESPACE

@@ -4,6 +4,7 @@ S3method(print,dash_component)
 export(Dash)
 export(dashNoUpdate)
 export(createCallbackId)
+export(clientsideFunction)
 export(input)
 export(output)
 export(state)

R/dash.R

@@ -84,6 +84,14 @@
 #'     object(s) (which should reference layout components), which become
 #'     argument values for the callback handler defined in `func`. 
 #'   }
+#'   \item{`clientside_callback(output = NULL, params = NULL, clientside_function = NULL)`}{
+#'     A callback function defintion. The `clientside_function` argument accepts a call
+#'     to clientsideFunction(), which describes the locally served JavaScript
+#'     function to call, and `output` defines which layout component property 
+#'     should adopt the results (via an [output] object). To determine what 
+#'     events trigger this callback, provide [input] (and/or [state]) object(s) 
+#'     (which should reference layout components) by passing them within `params` to `clientside_function`.
+#'   }
 #'   \item{`run_server(host =  Sys.getenv('DASH_HOST', "127.0.0.1"), 
 #'    port = Sys.getenv('DASH_PORT', 8050), block = TRUE, showcase = FALSE, ...)`}{
 #'     Launch the application. If provided, `host`/`port` set
@@ -221,7 +229,8 @@ Dash <- R6::R6Class(
           list(
             inputs=callback_signature$inputs,
             output=createCallbackId(callback_signature$output),
-            state=callback_signature$state
+            state=callback_signature$state,
+            clientside_function=callback_signature$clientside_function
           )
         }, private$callback_map)
 
@@ -534,14 +543,32 @@ Dash <- R6::R6Class(
 
       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 <- insertIntoCallbackMap(private$callback_map,
                                                     inputs,
                                                     output,
                                                     state,
-                                                    func)
-
+                                                    func,
+                                                    clientside_function=NULL)
+    },
+
+    # ------------------------------------------------------------------------
+    # clientside callback registration
+    # ------------------------------------------------------------------------
+
+    clientside_callback = function(output, params, clientside_function) {
+      assert_valid_callbacks(output, params, clientside_function)
+
+      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))]
+
+      private$callback_map <- insertIntoCallbackMap(private$callback_map,
+                                                    inputs,
+                                                    output,
+                                                    state,
+                                                    func = NULL,
+                                                    clientside_function)
     },
 
     # ------------------------------------------------------------------------

R/utils.R

@@ -352,11 +352,12 @@ clean_dependencies <- function(deps) {
   return(deps_with_file)
 }
 
-insertIntoCallbackMap <- function(map, inputs, output, state, func) {
+insertIntoCallbackMap <- function(map, inputs, output, state, func, clientside_function) {
   map[[createCallbackId(output)]] <- list(inputs=inputs,
                                           output=output,
                                           state=state,
-                                          func=func
+                                          func=func,
+                                          clientside_function=clientside_function
                                           )
   if (length(map) >= 2) {
     ids <- lapply(names(map), function(x) dash:::getIdProps(x)$ids)
@@ -365,7 +366,7 @@ insertIntoCallbackMap <- function(map, inputs, output, state, func) {
     outputs_as_list <- mapply(paste, ids, props, sep=".", SIMPLIFY = FALSE)
 
     if (length(Reduce(intersect, outputs_as_list))) {
-      stop(sprintf("One or more outputs are duplicated across callbacks. Please ensure that all ID and property combinations are unique."), call. = FALSE)        
+      stop(sprintf("One or more outputs are duplicated across callbacks. Please ensure that all ID and property combinations are unique."), call. = FALSE)
     }
   }
   return(map)
@@ -413,7 +414,9 @@ assert_valid_callbacks <- function(output, params, func) {
 
   # Assert that user_function is a valid function
   if(!(is.function(func))) {
-    stop(sprintf("The callback method's 'func' parameter requires a function as its argument. Please verify that 'func' is a valid, executable R function."), call. = FALSE)
+    if (!(all(names(func) == c("namespace", "function_name")))) {
+      stop(sprintf("The callback method's 'func' parameter requires an R function or clientside_function call as its argument. Please verify that 'func' is either a valid R function or clientside_function."), call. = FALSE)
+    }
   }
 
   # Check if inputs are a nested list
@@ -916,3 +919,7 @@ getIdProps <- function(output) {
   props <- vapply(unlist(idprops, recursive=FALSE), '[', character(1), 2)
   return(list(ids=ids, props=props))
 }
+
+clientsideFunction <- function(namespace, function_name) {
+  return(list(namespace=namespace, function_name=function_name))
+}

tests/integration/callbacks/test_clientside.py

@@ -0,0 +1,72 @@
+from selenium.webdriver.support.select import Select
+import time
+
+app = """
+library(dash)
+library(dashCoreComponents)
+library(dashHtmlComponents)
+
+app <- Dash$new()
+
+app$layout(htmlDiv(list(
+    dccInput(id='input'),
+    htmlDiv(id='output-clientside'),
+    htmlDiv(id='output-serverside')
+    )
+    )
+)
+
+app$callback( 
+  output(id = "output-serverside", property = "children"),
+  params = list(
+    input(id = "input", property = "value")
+  ),
+  function(value) {
+    sprintf("Server says %s", value)
+  }
+)
+
+app$clientside_callback(
+  output('output-clientside', 'children'),
+  params=list(input('input', 'value')),
+  clientsideFunction(
+    namespace = 'clientside',
+    function_name = 'display'
+    )
+)
+
+app$run_server()
+"""
+
+
+def test_rscc001_clientside(dashr):
+    dashr.start_server(app)
+    dashr.wait_for_text_to_equal(
+        '#output-clientside',
+        ''
+    )
+    dashr.wait_for_text_to_equal(
+        "#output-serverside",
+        "Server says NULL"
+    )
+    input1 = dashr.find_element("#input")
+    dashr.clear_input(input1)
+    input1.send_keys("Clientside")
+    dashr.wait_for_text_to_equal(
+        '#output-clientside',
+        'Client says "Clientside"'
+    )   
+    dashr.wait_for_text_to_equal(
+        "#output-serverside",
+        "Server says Clientside"
+    )
+    dashr.clear_input(input1)
+    input1.send_keys("Callbacks")
+    dashr.wait_for_text_to_equal(
+        '#output-clientside',
+        'Client says "Callbacks"'
+    )
+    dashr.wait_for_text_to_equal(
+        "#output-serverside",
+        "Server says Callbacks"
+    ) 

tests/integration/clientside/test_clientside.py

@@ -0,0 +1,73 @@
+from selenium.webdriver.support.select import Select
+import time, os
+
+app = """
+library(dash)
+library(dashCoreComponents)
+library(dashHtmlComponents)
+
+app <- Dash$new()
+
+app$layout(htmlDiv(list(
+    dccInput(id='input'),
+    htmlDiv(id='output-clientside'),
+    htmlDiv(id='output-serverside')
+    )
+    )
+)
+
+app$callback( 
+  output(id = "output-serverside", property = "children"),
+  params = list(
+    input(id = "input", property = "value")
+  ),
+  function(value) {
+    sprintf("Server says %s", value)
+  }
+)
+
+app$clientside_callback(
+  output('output-clientside', 'children'),
+  params=list(input('input', 'value')),
+  clientsideFunction(
+    namespace = 'clientside',
+    function_name = 'display'
+    )
+)
+
+app$run_server()
+"""
+
+
+def test_rscc001_clientside(dashr):
+    os.path.join(os.path.dirname(__file__), "assets")
+    dashr.start_server(app)
+    dashr.wait_for_text_to_equal(
+        '#output-clientside',
+        'Client says "undefined"'
+    )
+    dashr.wait_for_text_to_equal(
+        "#output-serverside",
+        "Server says NULL"
+    )
+    input1 = dashr.find_element("#input")
+    dashr.clear_input(input1)
+    input1.send_keys("Clientside")
+    dashr.wait_for_text_to_equal(
+        '#output-clientside',
+        'Client says "Clientside"'
+    )   
+    dashr.wait_for_text_to_equal(
+        "#output-serverside",
+        "Server says Clientside"
+    )
+    dashr.clear_input(input1)
+    input1.send_keys("Callbacks")
+    dashr.wait_for_text_to_equal(
+        '#output-clientside',
+        'Client says "Callbacks"'
+    )
+    dashr.wait_for_text_to_equal(
+        "#output-serverside",
+        "Server says Callbacks"
+    )