Implement support for asynchronous loading in Dash for R

CHANGELOG.md

@@ -1,8 +1,10 @@
 # Change Log for Dash for R
 All notable changes to this project will be documented in this file.
 
-## Unreleased
+## [0.2.0] - 2019-12-23
 ### Added
+- Support for asynchronous/dynamic loading of dependencies, resource caching, and asset fingerprinting [#157](https://github.com/plotly/dashR/pull/157)
+- Compression of text resources using `brotli`, `gzip`, or `deflate` [#157](https://github.com/plotly/dashR/pull/157)
 - Support for adding `<meta>` tags to index [#142](https://github.com/plotly/dashR/pull/142)
 - Hot reloading now supported in debug mode [#127](https://github.com/plotly/dashR/pull/127)
 - Support for displaying Dash for R applications within RStudio's viewer pane when `use_viewer = TRUE`

DESCRIPTION

@@ -1,19 +1,19 @@
 Package: dash
 Title: An Interface to the Dash Ecosystem for Authoring Reactive Web Applications
-Version: 0.1.0
+Version: 0.2.0
 Authors@R: c(person("Chris", "Parmer", role = c("aut"), email = "[email protected]"), person("Ryan Patrick", "Kyle", role = c("aut", "cre"), comment = c(ORCID = "0000-0001-5829-9867"), email = "[email protected]"), person("Carson", "Sievert", role = c("aut"), comment = c(ORCID = "0000-0002-4958-2844")), person(family = "Plotly Technologies", role = "cph")) 
 Description: A framework for building analytical web applications, Dash offers a pleasant and productive development experience. No JavaScript required.
 Depends:
   R (>= 3.0.2)
 Imports:
-  dashHtmlComponents (== 1.0.0),
-  dashCoreComponents (== 1.0.0),
-  dashTable (== 4.0.2),
+  dashHtmlComponents (== 1.0.2),
+  dashCoreComponents (== 1.6.0),
+  dashTable (== 4.5.1),
   R6,
   fiery (> 1.0.0),
   routr (> 0.2.0),
   plotly,
-  reqres,
+  reqres (>= 0.2.3),
   jsonlite,
   htmltools,
   assertthat,
@@ -31,9 +31,9 @@ Collate:
   'imports.R'
   'print.R'
   'internal.R'
-Remotes: plotly/dash-html-components@17da1f4,
-  plotly/dash-core-components@cc1e654,
-  plotly/dash-table@042ad65
+Remotes: plotly/dash-html-components@55c3884,
+  plotly/dash-core-components@c107e0f,
+  plotly/dash-table@3058bd5
 License: MIT + file LICENSE
 Encoding: UTF-8
 LazyData: true

R/dash.R

@@ -9,6 +9,7 @@
 #'   server = fiery::Fire$new(),
 #'   assets_folder = 'assets',
 #'   assets_url_path = '/assets',
+#'   eager_loading = FALSE,
 #'   assets_ignore = '',
 #'   serve_locally = TRUE,
 #'   meta_tags = NULL,
@@ -30,6 +31,7 @@
 #'   .css files will be loaded immediately unless excluded by `assets_ignore`,
 #'   and other files such as images will be served if requested. Default is `assets`. \cr
 #'   `assets_url_path` \tab \tab Character. Specify the URL path for asset serving. Default is `assets`. \cr
+#'   `eager_loading` \tab \tab Logical. Controls whether asynchronous resources are prefetched (if `TRUE`) or loaded on-demand (if `FALSE`). \cr
 #'   `assets_ignore` \tab \tab Character. A regular expression, to match assets to omit from
 #'   immediate loading. Ignored files will still be served if specifically requested. You
 #'   cannot use this to prevent access to sensitive files. \cr
@@ -126,7 +128,10 @@
 #'
 #' @examples
 #' \dontrun{
+#' library(dashCoreComponents)
+#' library(dashHtmlComponents)
 #' library(dash)
+
 #' app <- Dash$new()
 #' app$layout(
 #'  dccInput(id = "inputID", value = "initial value", type = "text"),
@@ -160,13 +165,15 @@ Dash <- R6::R6Class(
                           server = fiery::Fire$new(),
                           assets_folder = 'assets',
                           assets_url_path = '/assets',
+                          eager_loading = FALSE,
                           assets_ignore = '',
                           serve_locally = TRUE,
                           meta_tags = NULL,
                           routes_pathname_prefix = NULL,
                           requests_pathname_prefix = NULL,
                           external_scripts = NULL,
                           external_stylesheets = NULL,
+                          compress = TRUE,
                           suppress_callback_exceptions = FALSE) {
 
       # argument type checking
@@ -178,12 +185,14 @@ Dash <- R6::R6Class(
       # save relevant args as private fields
       private$name <- name
       private$serve_locally <- serve_locally
+      private$eager_loading <- eager_loading
       # remove leading and trailing slash(es) if present
       private$assets_folder <- gsub("^/+|/+$", "", assets_folder)
       # remove trailing slash in assets_url_path, if present
       private$assets_url_path <- sub("/$", "", assets_url_path)
       private$assets_ignore <- assets_ignore
       private$suppress_callback_exceptions <- suppress_callback_exceptions
+      private$compress <- compress      
       private$app_root_path <- getAppPath()
       private$app_launchtime <- as.integer(Sys.time())
       private$meta_tags <- meta_tags
@@ -240,6 +249,9 @@ Dash <- R6::R6Class(
         response$body <- to_JSON(lay, pretty = TRUE)
         response$status <- 200L
         response$type <- 'json'
+
+
+
         TRUE
       })
 
@@ -250,6 +262,7 @@ Dash <- R6::R6Class(
           response$body <- to_JSON(list())
           response$status <- 200L
           response$type <- 'json'
+
           return(FALSE)
         }
 
@@ -265,6 +278,8 @@ Dash <- R6::R6Class(
         response$body <- to_JSON(setNames(payload, NULL))
         response$status <- 200L
         response$type <- 'json'
+        if (private$compress)
+          response <- tryCompress(request, response)
         TRUE
       })
 
@@ -393,17 +408,33 @@ Dash <- R6::R6Class(
           response$status <- 500L
           private$stack_message <- NULL
         }
+
+        if (private$compress)
+          response <- tryCompress(request, response)
         TRUE
       })
 
       # This endpoint supports dynamic dependency loading
       # during `_dash-update-component` -- for reference:
-      # https://github.com/plotly/dash/blob/1249ffbd051bfb5fdbe439612cbec7fa8fff5ab5/dash/dash.py#L488
       # https://docs.python.org/3/library/pkgutil.html#pkgutil.get_data
+      #
+      # analogous to
+      # https://github.com/plotly/dash/blob/2d735aa250fc67b14dc8f6a337d15a16b7cbd6f8/dash/dash.py#L543-L551
       dash_suite <- paste0(self$config$routes_pathname_prefix, "_dash-component-suites/:package_name/:filename")
-
+      
       route$add_handler("get", dash_suite, function(request, response, keys, ...) {
         filename <- basename(file.path(keys$filename))
+
+        # checkFingerprint returns a list of length 2, the first element is
+        # the un-fingerprinted path, if a fingerprint is present (otherwise
+        # the original path is returned), while the second element indicates
+        # whether the original filename included a valid fingerprint (by
+        # Dash convention)
+        fingerprinting_metadata <- checkFingerprint(filename)
+
+        filename <- fingerprinting_metadata[[1]]
+        has_fingerprint <- fingerprinting_metadata[[2]] == TRUE
+
         dep_list <- c(private$dependencies_internal,
                       private$dependencies,
                       private$dependencies_user)
@@ -413,7 +444,6 @@ Dash <- R6::R6Class(
                                        clean_dependencies(dep_list)
                                        )
 
-
         # return warning if a dependency goes unmatched, since the page
         # will probably fail to render properly anyway without it
         if (length(dep_pkg$rpkg_path) == 0) {
@@ -424,16 +454,44 @@ Dash <- R6::R6Class(
           response$body <- NULL
           response$status <- 404L
         } else {
+          # need to check for debug mode, don't cache, don't etag
+          # if debug mode is not active
           dep_path <- system.file(dep_pkg$rpkg_path,
                                   package = dep_pkg$rpkg_name)
-
+          
           response$body <- readLines(dep_path,
                                      warn = FALSE,
                                      encoding = "UTF-8")
-          response$status <- 200L
+
+          if (!private$debug && has_fingerprint) {
+            response$status <- 200L
+            response$set_header('Cache-Control',
+                                sprintf('public, max-age=%s',
+                                        31536000) # 1 year
+            )
+          } else if (!private$debug && !has_fingerprint) {
+            modified <- as.character(as.integer(file.mtime(dep_path)))
+
+            response$set_header('ETag', modified)
+
+            request_etag <- request$headers[["If-None-Match"]]
+
+            if (!is.null(request_etag) && modified == request_etag) {
+              response$body <- NULL
+              response$status <- 304L
+            } else {
+              response$status <- 200L
+            } 
+          } else {
+            response$status <- 200L
+          }
+
           response$type <- get_mimetype(filename)
         }
 
+        if (private$compress && length(response$body) > 0)
+          response <- tryCompress(request, response)
+
         TRUE
       })
 
@@ -476,14 +534,20 @@ Dash <- R6::R6Class(
             response$body <- readLines(asset_path,
                                        warn = FALSE,
                                        encoding = "UTF-8")
+
+            if (private$compress && length(response$body) > 0) {
+              response <- tryCompress(request, response)
+            }
           } else {
             file_handle <- file(asset_path, "rb")
+            file_size <- file.size(asset_path)
+
             response$body <- readBin(file_handle,
                                      raw(),
-                                     file.size(asset_path))
+                                     file_size)
             close(file_handle)
           }
-
+          
           response$status <- 200L
         }
         TRUE
@@ -501,8 +565,13 @@ Dash <- R6::R6Class(
                                  file.size(asset_path))
         close(file_handle)
 
+        response$set_header('Cache-Control',
+                            sprintf('public, max-age=%s',
+                                    '31536000')
+                            )
         response$type <- 'image/x-icon'
         response$status <- 200L
+
         TRUE
       })
 
@@ -512,6 +581,9 @@ Dash <- R6::R6Class(
         response$body <- private$.index
         response$status <- 200L
         response$type <- 'html'
+
+        if (private$compress)
+          response <- tryCompress(request, response)
         TRUE
       })
 
@@ -540,6 +612,7 @@ Dash <- R6::R6Class(
         response$body <- to_JSON(resp)
         response$status <- 200L
         response$type <- 'json'
+
         # reset the field for the next reloading operation
         private$modified_since_reload <- list()
         TRUE
@@ -830,13 +903,15 @@ Dash <- R6::R6Class(
     # private fields defined on initiation
     name = NULL,
     serve_locally = NULL,
+    eager_loading = NULL,
     meta_tags = NULL,
     assets_folder = NULL,
     assets_url_path = NULL,
     assets_ignore = NULL,
     routes_pathname_prefix = NULL,
     requests_pathname_prefix = NULL,
     suppress_callback_exceptions = NULL,
+    compress = NULL,
     asset_map = NULL,
     css = NULL,
     scripts = NULL,
@@ -1188,7 +1263,24 @@ Dash <- R6::R6Class(
       css_deps <- render_dependencies(css_deps,
                                       local = private$serve_locally,
                                       prefix=self$config$requests_pathname_prefix)
-
+
+      # ensure that no dependency has both async and dynamic set
+      if (any(
+        vapply(depsAll, function(dep)
+          length(intersect(c("dynamic", "async"), names(dep))) > 1,
+          logical(1)
+        )
+       )
+      ) 
+        stop("Can't have both 'dynamic' and 'async' in a Dash dependency; please correct and reload.", call. = FALSE)
+
+      # remove dependencies which are dynamic from the script list
+      # to avoid placing them into the index
+      depsAll <- depsAll[!vapply(depsAll, 
+                                 isDynamic, 
+                                 logical(1), 
+                                 eager_loading = private$eager_loading)]
+
       # scripts go after dash-renderer dependencies (i.e., React),
       # but before dash-renderer itself
       scripts_deps <- compact(lapply(depsAll, function(dep) {