Support inline clientside callbacks in Dash for R (#140)

* ✨ support inline clientside callbacks

* 📚 update docs

* 🚨 add inline clientside test

* Update CHANGELOG.md

Author: rpkyle

CHANGELOG.md

@@ -1,6 +1,9 @@
 # Change Log for Dash for R
 All notable changes to this project will be documented in this file.
 
+## Unreleased
+### Added
+- Support for inline clientside callbacks in JavaScript [#140](https://github.com/plotly/dashR/pull/140)
 
 ## [0.3.0] - 2020-02-12
 ### Added

R/dash.R

@@ -23,7 +23,7 @@
 #'
 #' @section Arguments:
 #' \tabular{lll}{
-#'   `name` \tab \tab Character. The name of the Dash application (placed in the `<title>`
+#'   `name` \tab \tab Character. The name of the Dash application (placed in the title
 #'   of the HTML page). DEPRECATED; please use `index_string()` or `interpolate_index()` instead.\cr
 #'   `server` \tab \tab The web server used to power the application.
 #'   Must be a [fiery::Fire] object.\cr
@@ -87,18 +87,21 @@
 #'     \describe{
 #'       \item{output}{a named list including a component `id` and `property`}
 #'       \item{params}{an unnamed list of [input] and [state] statements, each with defined `id` and `property`}
-#'       \item{func}{any valid R function which generates [output] provided [input] and/or [state] arguments, or a call to [clientsideFunction] including `namespace` and `function_name` arguments for a locally served JavaScript function}
+#'       \item{func}{any valid R function which generates [output] provided [input] and/or [state] arguments,
+#'       a character string containing valid JavaScript, or a call to [clientsideFunction] including `namespace`
+#'       and `function_name` arguments for a locally served JavaScript function}
 #'     }
 #'     The `output` argument defines which layout component property should
 #'     receive the results (via the [output] object). The events that
 #'     trigger the callback are then described by the [input] (and/or [state])
 #'     object(s) (which should reference layout components), which become
 #'     argument values for R callback handlers defined in `func`. Here `func` may
-#'     either be an anonymous R function, or a call to `clientsideFunction()`, which
-#'     describes a locally served JavaScript function instead. The latter defines a
-#'     "clientside callback", which updates components without passing data to and
+#'     either be an anonymous R function, a JavaScript function provided as a
+#'     character string, or a call to `clientsideFunction()`, which describes a
+#'     locally served JavaScript function instead. The latter two methods define
+#'     a "clientside callback", which updates components without passing data to and
 #'     from the Dash backend. The latter may offer improved performance relative
-#'     to callbacks written in R.
+#'     to callbacks written purely in R.
 #'   }
 #'   \item{`title("dash")`}{
 #'     The title of the app. If no title is supplied, Dash for R will use 'dash'.
@@ -119,8 +122,8 @@
 #'   }
 #'   \item{`get_relative_path(path, requests_pathname_prefix)`}{
 #'     The `get_relative_path` method simplifies the handling of URLs and pathnames for apps
-#'     running locally and on a deployment server such as Dash Enterprise. It handles the prefix 
-#'     for requesting assets similar to the `get_asset_url` method, but can also be used for URL handling 
+#'     running locally and on a deployment server such as Dash Enterprise. It handles the prefix
+#'     for requesting assets similar to the `get_asset_url` method, but can also be used for URL handling
 #'     in components such as `dccLink` or `dccLocation`. For example, `app$get_relative_url("/page/")`
 #'     would return `/app/page/` for an app running on a deployment server. The path must be prefixed with
 #'     a `/`.
@@ -132,8 +135,8 @@
 #'     The `strip_relative_path` method simplifies the handling of URLs and pathnames for apps
 #'     running locally and on a deployment server such as Dash Enterprise. It acts almost opposite the `get_relative_path`
 #'     method, by taking a `relative path` as an input, and returning the `path` stripped of the `requests_pathname_prefix`,
-#'     and any leading or trailing `/`. For example, a path string `/app/homepage/`, would be returned as 
-#'     `homepage`. This is particularly useful for `dccLocation` URL routing. 
+#'     and any leading or trailing `/`. For example, a path string `/app/homepage/`, would be returned as
+#'     `homepage`. This is particularly useful for `dccLocation` URL routing.
 #'     \describe{
 #'       \item{path}{Character. A path string prefixed with a leading `/` and `requests_pathname_prefix` which directs at a path or asset directory.}
 #'       \item{requests_pathname_prefix}{Character. The pathname prefix for the app on a deployed application. Defaults to the environment variable set by the server, or `""` if run locally.}
@@ -183,17 +186,17 @@
 #'     but offers the ability to change the default components of the Dash index as seen in the example below:
 #'     \preformatted{
 #'     app$interpolate_index(
-#'       template_index, 
-#'       metas = "<meta_charset='UTF-8'/>", 
-#'       renderer = renderer, 
+#'       template_index,
+#'       metas = "<meta_charset='UTF-8'/>",
+#'       renderer = renderer,
 #'       config = config)
 #'     }
 #'     \describe{
 #'     \item{template_index}{Character. A formatted string with the HTML index string. Defaults to the initial template}
 #'     \item{...}{Named List. The unnamed arguments can be passed as individual named lists corresponding to the components
 #'     of the Dash html index. These include the same arguments as those found in the `index_string()` template.}
 #'     }
-#'  } 
+#'  }
 #'  \item{`run_server(host =  Sys.getenv('HOST', "127.0.0.1"),
 #'    port = Sys.getenv('PORT', 8050), block = TRUE, showcase = FALSE, ...)`}{
 #'     The `run_server` method has 13 formal arguments, several of which are optional:
@@ -778,6 +781,25 @@ Dash <- R6::R6Class(
 
       if (is.function(func)) {
         clientside_function <- NULL
+      } else if (is.character(func)) {
+        # update the scripts before generating tags, and remove exact
+        # duplicates from inline_scripts
+        fn_name <- paste0("_dashprivate_", output$id)
+
+        func <- paste0('<script>\n',
+                       'var clientside = window.dash_clientside = window.dash_clientside || {};\n',
+                       'var ns = clientside["', fn_name, '"] = clientside["', fn_name, '"] || {};\n',
+                       'ns["', output$property, '"] = \n',
+                       func,
+                       '\n;',
+                       '</script>')
+
+        private$inline_scripts <- unique(c(private$inline_scripts, func))
+
+        clientside_function <- clientsideFunction(namespace = fn_name,
+                                                  function_name = output$property)
+
+        func <- NULL
       } else {
         clientside_function <- func
         func <- NULL
@@ -801,13 +823,13 @@ Dash <- R6::R6Class(
       }
       private$callback_context_
     },
-    
+
     # ------------------------------------------------------------------------
     # return asset URLs
     # ------------------------------------------------------------------------
     get_asset_url = function(asset_path, prefix = self$config$requests_pathname_prefix) {
       app_root_path <- Sys.getenv("DASH_APP_PATH")
-      
+
       if (app_root_path == "" && getAppPath() != FALSE) {
         # app loaded via source(), root path is known
         app_root_path <- dirname(private$app_root_path)
@@ -816,52 +838,52 @@ Dash <- R6::R6Class(
         warning("application not started via source(), and DASH_APP_PATH environment variable is undefined. get_asset_url returns NULL since root path cannot be reliably identified.")
         return(NULL)
       }
-      
-      asset <- lapply(private$asset_map, 
+
+      asset <- lapply(private$asset_map,
                       function(x) {
                         # asset_path should be prepended with the full app root & assets path
                         # if leading slash(es) present in asset_path, remove them before
                         # assembling full asset path
                         asset_path <- file.path(app_root_path,
-                                                private$assets_folder, 
+                                                private$assets_folder,
                                                 sub(pattern="^/+",
                                                     replacement="",
                                                     asset_path))
                         return(names(x[x == asset_path]))
                       }
       )
       asset <- unlist(asset, use.names = FALSE)
-      
+
       if (length(asset) == 0)
         stop(sprintf("the asset path '%s' is not valid; please verify that this path exists within the '%s' directory.",
                      asset_path,
                      private$assets_folder))
-      
+
       # strip multiple slashes if present, since we'll
       # introduce one when we concatenate the prefix and
       # asset path & prepend the asset name with route prefix
       return(gsub(pattern="/+",
                   replacement="/",
-                  paste(prefix, 
-                        private$assets_url_path, 
-                        asset, 
+                  paste(prefix,
+                        private$assets_url_path,
+                        asset,
                         sep="/")))
     },
-    
+
     # ------------------------------------------------------------------------
     # return relative asset URLs
     # ------------------------------------------------------------------------
-    
+
     get_relative_path = function(path, requests_pathname_prefix = self$config$requests_pathname_prefix) {
       asset = get_relative_path(requests_pathname = requests_pathname_prefix, path = path)
       return(asset)
     },
-    
-    
+
+
     # ------------------------------------------------------------------------
     # return relative asset URLs
     # ------------------------------------------------------------------------
-    
+
     strip_relative_path = function(path, requests_pathname_prefix = self$config$requests_pathname_prefix) {
       asset = strip_relative_path(requests_pathname = requests_pathname_prefix, path = path)
       return(asset)
@@ -872,32 +894,32 @@ Dash <- R6::R6Class(
     index_string = function(string) {
       private$custom_index <- validate_keys(string)
     },
-    
+
     # ------------------------------------------------------------------------
-    # modify the templated variables by using the `interpolate_index` method. 
+    # modify the templated variables by using the `interpolate_index` method.
     # ------------------------------------------------------------------------
     interpolate_index = function(template_index = private$template_index[[1]], ...) {
       template = template_index
       kwargs <- list(...)
-      
+
       for (name in names(kwargs)) {
         key = paste0('\\{\\%', name, '\\%\\}')
         template = sub(key, kwargs[[name]], template)
-      } 
-      
+      }
+
       invisible(validate_keys(names(kwargs)))
-      
+
       private$template_index <- template
     },
-    
+
     # ------------------------------------------------------------------------
     # specify a custom title
     # ------------------------------------------------------------------------
     title = function(string = "dash") {
       assertthat::assert_that(is.character(string))
       private$name <- string
     },
-        
+
     # ------------------------------------------------------------------------
     # convenient fiery wrappers
     # ------------------------------------------------------------------------
@@ -1385,6 +1407,9 @@ Dash <- R6::R6Class(
     # the input/output mapping passed back-and-forth between the client & server
     callback_map = list(),
 
+    # the list of inline scripts passed as strings via (clientside) callbacks
+    inline_scripts = list(),
+
     # akin to https://github.com/plotly/dash-renderer/blob/master/dash_renderer/__init__.py
     react_version_enabled= function() {
       version <- private$dependencies_internal$`react-prod`$version
@@ -1455,7 +1480,7 @@ Dash <- R6::R6Class(
       depsAll <- compact(c(
         private$react_deps()[private$react_versions() %in% private$react_version_enabled()],
         private$dependencies_internal[grepl(pattern = "prop-types", x = private$dependencies_internal)],
-        private$dependencies_internal[grepl(pattern = "polyfill", x = private$dependencies_internal)],        
+        private$dependencies_internal[grepl(pattern = "polyfill", x = private$dependencies_internal)],
         private$dependencies,
         private$dependencies_user,
         private$dependencies_internal[grepl(pattern = "dash-renderer", x = private$dependencies_internal)]
@@ -1554,6 +1579,9 @@ Dash <- R6::R6Class(
                                          "application/javascript",
                                          "var renderer = new DashRenderer();")
 
+      # add inline tags
+      scripts_inline <- private$inline_scripts
+
       # serving order of CSS and JS tags: package -> external -> assets
       css_tags <- paste(c(css_deps,
                           css_external,
@@ -1563,6 +1591,7 @@ Dash <- R6::R6Class(
       scripts_tags <- paste(c(scripts_deps,
                               scripts_external,
                               scripts_assets,
+                              scripts_inline,
                               scripts_invoke_renderer),
                             collapse = "\n              ")
 
@@ -1590,21 +1619,21 @@ Dash <- R6::R6Class(
 
       # insert meta tags if present
       meta_tags <- all_tags[["meta_tags"]]
-      
+
       # define the react-entry-point
       app_entry <- "<div id='react-entry-point'><div class='_dash-loading'>Loading...</div></div>"
       # define the dash default config key
       config <- sprintf("<script id='_dash-config' type='application/json'> %s </script>", to_JSON(self$config))
 
       if (is.null(private$name))
         private$name <- 'dash'
-      
+
       if (!is.null(private$custom_index)) {
         string_index <- glue::glue(private$custom_index, .open = "{%", .close = "%}")
-        
+
         private$.index <- string_index
       }
-      
+
       else if (length(private$template_index) == 1) {
         private$.index <- private$template_index
       }

R/utils.R

@@ -467,7 +467,7 @@ resolvePrefix <- function(prefix, environment_var, base_pathname) {
     prefix_env <- Sys.getenv(environment_var)
     env_base_pathname <- Sys.getenv("DASH_URL_BASE_PATHNAME")
     app_name <- Sys.getenv("DASH_APP_NAME")
-    
+
     if (prefix_env != "")
       return(prefix_env)
     else if (app_name != "")
@@ -1118,6 +1118,8 @@ dashLogger <- function(event = NULL,
 #' Define a clientside callback
 #'
 #' Create a callback that updates the output by calling a clientside (JavaScript) function instead of an R function.
+#' Note that it is also possible to specify JavaScript as a character string instead of passing `clientsideFunction`.
+#' In this case Dash will inline your JavaScript automatically, without needing to save a script inside `assets`.
 #'
 #' @param namespace Character. Describes where the JavaScript function resides (Dash will look
 #' for the function at `window[namespace][function_name]`.)
@@ -1147,7 +1149,16 @@ dashLogger <- function(event = NULL,
 #'   namespace = 'my_clientside_library',
 #'   function_name = 'my_function'
 #'   )
-#' )}
+#' )
+#'
+#' # Passing JavaScript as a character string
+#' app$callback(
+#'  output('output-clientside', 'children'),
+#'  params=list(input('input', 'value')),
+#'  "function (value) {
+#'        return 'Client says \"' + value + '\"';
+#'  }"
+#')}
 clientsideFunction <- function(namespace, function_name) {
   return(list(namespace=namespace, function_name=function_name))
 }
@@ -1274,8 +1285,8 @@ tryCompress <- function(request, response) {
 get_relative_path <- function(requests_pathname, path) {
   # Returns a path with the config setting 'requests_pathname_prefix' prefixed to
   # it. This is particularly useful for apps deployed on Dash Enterprise, which makes
-  # it easier to serve apps under both URL prefixes and localhost. 
-  
+  # it easier to serve apps under both URL prefixes and localhost.
+
   if (requests_pathname == "/" && path == "") {
     return("/")
   }
@@ -1295,7 +1306,7 @@ get_relative_path <- function(requests_pathname, path) {
 strip_relative_path <- function(requests_pathname, path) {
   # Returns a relative path with the `requests_pathname_prefix` and leadings and trailing
   # slashes stripped from it. This function is particularly relevant to dccLocation pathname routing.
-  
+
   if (is.null(path)) {
     return(NULL)
   }
@@ -1316,27 +1327,27 @@ strip_relative_path <- function(requests_pathname, path) {
 interpolate_str <- function(index_template, ...) {
   # This function takes an index string, along with
   # user specified keys for the html keys of the index
-  # and sets the default values of the keys to the 
+  # and sets the default values of the keys to the
   # ones specified by the keys themselves, returning
-  # the custom index template. 
-  template = index_template 
+  # the custom index template.
+  template = index_template
   kwargs <- list(...)
-  
+
   for (name in names(kwargs)) {
     key = paste0('\\{', name, '\\}')
-    
+
     template = sub(key, kwargs[[name]], template)
-  } 
+  }
   return(template)
 }
 
 validate_keys <- function(string) {
   required_keys <- c("app_entry", "config", "scripts")
-  
+
   keys_present <- vapply(required_keys, function(x) grepl(x, string), logical(1))
-  
+
   if (!all(keys_present)) {
-    stop(sprintf("Did you forget to include %s in your index string?", 
+    stop(sprintf("Did you forget to include %s in your index string?",
                  paste(names(keys_present[keys_present==FALSE]), collapse = ", ")))
   } else {
     return(string)