Add support for callback graph improvements and timing (#224)

Author: rpkyle

DESCRIPTION

@@ -39,7 +39,7 @@ License: MIT + file LICENSE
 Encoding: UTF-8
 LazyData: true
 KeepSource: true
-RoxygenNote: 7.1.0
+RoxygenNote: 7.1.1
 Roxygen: list(markdown = TRUE)
 URL: https://github.com/plotly/dashR
 BugReports: https://github.com/plotly/dashR/issues

R/dash.R

@@ -386,14 +386,15 @@ Dash <- R6::R6Class(
 
           if (!private$debug && has_fingerprint) {
             response$status <- 200L
-            response$set_header('Cache-Control',
-                                sprintf('public, max-age=%s',
-                                        31536000) # 1 year
+            response$append_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)
+            response$append_header('ETag',
+                                   modified)
 
             request_etag <- request$get_header('If-None-Match')
 
@@ -480,9 +481,9 @@ Dash <- R6::R6Class(
                                  file.size(asset_path))
         close(file_handle)
 
-        response$set_header('Cache-Control',
-                            sprintf('public, max-age=%s',
-                                    '31536000')
+        response$append_header('Cache-Control',
+                               sprintf('public, max-age=%s',
+                               '31536000')
                             )
         response$type <- 'image/x-icon'
         response$status <- 200L
@@ -831,9 +832,46 @@ Dash <- R6::R6Class(
       if (is.null(private$callback_context_)) {
         warning("callback_context is undefined; callback_context may only be accessed within a callback.")
       }
+
       private$callback_context_
     },
 
+    # ------------------------------------------------------------------------
+    # request and return callback timing data
+    # ------------------------------------------------------------------------
+    #' @description
+    #' Records timing information for a server resource.
+    #' @details
+    #' The `callback_context.record_timing` method permits retrieving the
+    #' duration required to execute a given callback. It may only be called
+    #' from within a callback; a warning will be thrown and the method will
+    #' otherwise return `NULL` if invoked outside of a callback.
+    #' 
+    #' @param name Character. The name of the resource.
+    #' @param duration Numeric. The time in seconds to report. Internally, this is
+    #' rounded to the nearest millisecond.
+    #' @param description Character. A description of the resource.
+    #'
+    callback_context.record_timing = function(name,
+                                              duration=NULL, 
+                                              description=NULL) {
+      if (is.null(private$callback_context_)) {
+        warning("callback_context is undefined; callback_context.record_timing may only be accessed within a callback.")
+        return(NULL)
+      }
+
+      timing_information <- self$server$get_data("timing-information")
+
+      if (name %in% timing_information) {
+        stop(paste0("Duplicate resource name ", name, " found."), call.=FALSE)
+      }
+
+      timing_information[[name]] <- list("dur" = round(duration * 1000), 
+                                         "desc" = description)
+
+      self$server$set_data("timing-information", timing_information)
+    },
+
     # ------------------------------------------------------------------------
     # return asset URLs
     # ------------------------------------------------------------------------
@@ -1221,6 +1259,42 @@ Dash <- R6::R6Class(
       self$config$silence_routes_logging <- dev_tools_silence_routes_logging
       self$config$props_check <- dev_tools_props_check
 
+      if (private$debug && self$config$ui) {
+        self$server$on('before-request', function(server, ...) {
+          self$server$set_data("timing-information", list(
+            "__dash_server" = list(
+              "dur" = as.numeric(Sys.time()),
+              "desc" = NULL
+            )
+          ))
+        })
+
+        self$server$on('request', function(server, request, ...) {
+          timing_information <- self$server$get_data('timing-information')
+          dash_total <- timing_information[['__dash_server']]
+          timing_information[['__dash_server']][['dur']] <- round((as.numeric(Sys.time()) - dash_total[['dur']]) * 1000)
+          
+          header_as_string <- list()
+
+          for (item in seq_along(timing_information)) {
+            header_content <- names(timing_information[item])
+
+            if (!is.null(timing_information[[item]]$desc)) {
+              header_content <- paste0(header_content, ';desc="', timing_information[[item]]$desc, '"')
+            }
+
+            if (!is.null(timing_information[[item]]$dur)) {
+              header_content <- paste0(header_content, ';dur=', timing_information[[item]]$dur)
+            }
+            
+             header_as_string[[item]] <- header_content
+          }
+
+          request$response$append_header('Server-Timing', 
+                                         paste0(unlist(header_as_string), collapse=", "))
+        })
+      }
+
       if (hot_reload == TRUE & !(is.null(source_dir))) {
         self$server$on('cycle-end', function(server, ...) {
           # handle case where assets are not present, since we can still hot reload the app itself
@@ -1327,10 +1401,19 @@ Dash <- R6::R6Class(
 
           # reset the timestamp so we're able to determine when the last cycle end occurred
           private$last_cycle <- as.integer(Sys.time())
+
+          # flush the context to prepare for the next request cycle
+          self$server$set_data("timing-information", list())
         })
       } else if (hot_reload == TRUE & is.null(source_dir)) {
           message("\U{26A0} No source directory information available; hot reloading has been disabled.\nPlease ensure that you are loading your Dash for R application using source().\n")
-        }
+        } else if (hot_reload == FALSE && private$debug && self$config$ui) {
+            self$server$on("cycle-end", function(server, ...) {
+              # flush the context to prepare for the next request cycle
+              self$server$set_data("timing-information", list())
+            })
+        } 
+
       self$server$ignite(block = block, showcase = showcase, ...)
       }
     ),