Easier specification of external file dependencies

NAMESPACE

@@ -1,14 +1,18 @@
-# Generated by roxygen2 (4.0.2): do not edit by hand
+# Generated by roxygen2 (4.1.1): do not edit by hand
 
 S3method(as.tags,htmlwidget)
 S3method(print,htmlwidget)
 S3method(print,suppress_viewer)
 export(JS)
+export(attachment)
 export(createWidget)
+export(fileDependency)
 export(saveWidget)
 export(scaffoldWidget)
 export(shinyRenderWidget)
 export(shinyWidgetOutput)
 export(sizingPolicy)
 import(RJSONIO)
+import(bitops)
+import(digest)
 import(htmltools)

R/fileDependency.R

@@ -0,0 +1,72 @@
+# Given a file path (that exists), return a hash of the contents and the
+# full file path.
+generateFileDependencyKey <- function(filename) {
+  filename <- normalizePath(filename, mustWork = TRUE)
+  hash1 <- digest::digest(file = filename, algo = "sha1", raw = TRUE)
+  hash2 <- digest::digest(filename, algo = "sha1", raw = TRUE)
+  paste0(as.raw(bitops::bitXor(hash1, hash2)), collapse = "")
+}
+
+#' Create a file dependency that can be accessed by the client using javascript.
+#' @export
+fileDependency <- function(filename, version = '0.0.1'){
+  # We use an opaque name so that if the file contents change, an entirely
+  # different fileDependency is served (to avoid stale cached data).
+  htmltools::htmlDependency(
+    name = generateFileDependencyKey(filename),
+    version = version,
+    src = dirname(filename),
+    attachment = basename(filename)
+  )
+}
+
+#' Mark a string as an attachment
+#' @export
+attachment <- function(x){
+  structure(
+    "{attachment}",
+    class = unique(c("ATTACHMENT", oldClass(x))),
+    attachmentPath = normalizePath(x, mustWork = TRUE)
+  )
+}
+
+attachmentDeps <- function(list) {
+  # This removes all of the non-attachments, and replaces the attachment value
+  # (which is always the string literal "{attachment}") with the attachmentPath
+  # attribute, which is where the actual path is stored. The resulting structure
+  # still retains the shape of the original list.
+  #
+  # Note that even though we want a flat list later, we can't use how = "unlist"
+  # because that causes the extra attributes like attachmentPath to be dropped
+  # before we get a chance to see them.
+  attachments <- rapply(list, classes = "ATTACHMENT", how = "list", function(x) {
+    attr(x, "attachmentPath", exact = TRUE)
+  })
+
+  # Remove the shape of the original list. The names in the resulting vector
+  # reflect the "key" of the attachment location, if and only if named lists
+  # were used all the way. For example:
+  #   list(a = list(b = attachment("foo.csv")))
+  # would result in
+  #   c("a.b" = "foo.csv")
+  # which is great.
+  #
+  # However:
+  #   list(a = list(attachment("foo.csv"), attachment("bar.csv")))
+  # would result in this:
+  #   c(a1 = "foo.csv", a2 = "bar.csv")
+  #
+  # which isn't exactly what we're looking for (a.1 or a.#1 maybe?). This
+  # implies that this feature will not work correctly with key paths that
+  # include unnamed elements (or names with periods for that matter).
+  attachments <- unlist(attachments)
+
+  # Create a fileDependency for each one.
+  deps <- lapply(attachments, fileDependency)
+  attachments <- lapply(as.list(attachments), function(x){
+    generateFileDependencyKey(x)
+  })
+
+  list(attachments = attachments, deps = deps)
+}
+

R/htmlwidgets.R

@@ -89,9 +89,10 @@ toHTML <- function(x, standalone = FALSE, knitrOptions = NULL) {
       )
     }
   )
+  attachments = attachmentDeps(x$x)
   html <- htmltools::attachDependencies(html,
     c(widget_dependencies(class(x)[1], attr(x, 'package')),
-      x$dependencies)
+      x$dependencies, attachments$deps)
   )
 
   htmltools::browsable(html)
@@ -123,8 +124,9 @@ widget_dependencies <- function(name, package){
 # to be picked up by htmlwidgets.js for static rendering.
 widget_data <- function(x, id, ...){
   evals <- JSEvals(x$x)
+  attachments = attachmentDeps(x$x)$attachments
   tags$script(type="application/json", `data-for` = id,
-    HTML(toJSON(list(x = x$x, evals = evals), collapse = "", digits = 16))
+    HTML(toJSON(list(x = x$x, evals = evals, attachments = attachments), collapse = "", digits = 16))
   )
 }
 
@@ -271,12 +273,14 @@ shinyRenderWidget <- function(expr, outputFunction, env, quoted) {
     }
     x <- .subset2(instance, "x")
     deps <- .subset2(instance, "dependencies")
+    attachments = attachmentDeps(x)
+    deps = c(deps, attachments$deps)
     deps <- lapply(
       htmltools::resolveDependencies(deps),
       shiny::createWebDependency
     )
     evals = JSEvals(x)
-    list(x = x, evals = evals, deps = deps)
+    list(x = x, evals = evals, deps = deps, attachments = attachments$attachments)
   }
 
   # mark it with the output function so we can use it in Rmd files

R/imports.R

@@ -1,2 +1,2 @@
-#' @import htmltools RJSONIO
+#' @import htmltools RJSONIO bitops digest
 NULL

inst/www/htmlwidgets.js

@@ -398,6 +398,7 @@
             }
           }
           Shiny.renderDependencies(data.deps);
+          resolveAttachmentUrls(data)
           superfunc(el, data.x, elementData(el, "init_result"));
         };
       });
@@ -472,6 +473,7 @@
           for (var i = 0; data.evals && i < data.evals.length; i++) {
             window.HTMLWidgets.evaluateStringMember(data.x, data.evals[i]);
           }
+          resolveAttachmentUrls(data)
           binding.renderValue(el, data.x, initResult);
         }
       }
@@ -566,6 +568,34 @@
     }
     return results;
   }
+  // Set value of a property that is nested deep
+  // var dat = {a: {b: {c: 2}}}
+  // setDeepProperty(dat, "a.b", {d: 10})
+  // {a: {b: {d: 10}}}
+  function setDeepProperty(obj, path, value){
+    var path = path.split(".")
+    //var path = splitWithEscape(path, '.', '\\')
+    var path2 = path.slice(0, path.length - 1)
+    var x = path2.reduce(function(prev, cur){
+      return prev[cur]
+    }, obj)
+    if (typeof value === 'undefined'){
+      console.log('undefined')
+      return x[path[path.length - 1]]
+    } else {
+      x[path[path.length - 1]] = value
+    }
+  }
+  // Resolve attachment urls
+  function resolveAttachmentUrls(data){
+    if (data.attachments){
+      Object.keys(data.attachments).map(function(k){
+        setDeepProperty(data.x, k,
+            HTMLWidgets.getAttachmentUrl(data.attachments[k], 1)
+        )
+      })
+    }
+  }
   // Function authored by Yihui/JJ Allaire
   window.HTMLWidgets.evaluateStringMember = function(o, member) {
     var parts = splitWithEscape(member, '.', '\\');

man/JS.Rd

@@ -1,4 +1,5 @@
-% Generated by roxygen2 (4.0.2): do not edit by hand
+% Generated by roxygen2 (4.1.1): do not edit by hand
+% Please edit documentation in R/utils.R
 \name{JS}
 \alias{JS}
 \title{Mark character strings as literal JavaScript code}

man/attachment.Rd

@@ -0,0 +1,12 @@
+% Generated by roxygen2 (4.1.1): do not edit by hand
+% Please edit documentation in R/fileDependency.R
+\name{attachment}
+\alias{attachment}
+\title{Mark a string as an attachment}
+\usage{
+attachment(x)
+}
+\description{
+Mark a string as an attachment
+}
+

man/createWidget.Rd

@@ -1,4 +1,5 @@
-% Generated by roxygen2 (4.0.2): do not edit by hand
+% Generated by roxygen2 (4.1.1): do not edit by hand
+% Please edit documentation in R/htmlwidgets.R
 \name{createWidget}
 \alias{createWidget}
 \title{Create an HTML Widget}

man/fileDependency.Rd

@@ -0,0 +1,12 @@
+% Generated by roxygen2 (4.1.1): do not edit by hand
+% Please edit documentation in R/fileDependency.R
+\name{fileDependency}
+\alias{fileDependency}
+\title{Create a file dependency that can be accessed by the client using javascript.}
+\usage{
+fileDependency(filename, version = "0.0.1")
+}
+\description{
+Create a file dependency that can be accessed by the client using javascript.
+}
+

man/htmlwidgets-shiny.Rd

@@ -1,4 +1,5 @@
-% Generated by roxygen2 (4.0.2): do not edit by hand
+% Generated by roxygen2 (4.1.1): do not edit by hand
+% Please edit documentation in R/htmlwidgets.R
 \name{htmlwidgets-shiny}
 \alias{htmlwidgets-shiny}
 \alias{shinyRenderWidget}

man/saveWidget.Rd

@@ -1,4 +1,5 @@
-% Generated by roxygen2 (4.0.2): do not edit by hand
+% Generated by roxygen2 (4.1.1): do not edit by hand
+% Please edit documentation in R/savewidget.R
 \name{saveWidget}
 \alias{saveWidget}
 \title{Save a widget to an HTML file}

man/scaffoldWidget.Rd

@@ -1,4 +1,5 @@
-% Generated by roxygen2 (4.0.2): do not edit by hand
+% Generated by roxygen2 (4.1.1): do not edit by hand
+% Please edit documentation in R/scaffold.R
 \name{scaffoldWidget}
 \alias{scaffoldWidget}
 \title{Create implementation scaffolding for an HTML widget}

man/sizingPolicy.Rd

@@ -1,4 +1,5 @@
-% Generated by roxygen2 (4.0.2): do not edit by hand
+% Generated by roxygen2 (4.1.1): do not edit by hand
+% Please edit documentation in R/sizing.R
 \name{sizingPolicy}
 \alias{sizingPolicy}
 \title{Create a widget sizing policy}