From 5b912abc8a1849f59f231eedfb7100774132ad7e Mon Sep 17 00:00:00 2001 From: Ramnath Vaidyanathan Date: Thu, 15 Jan 2015 16:33:33 -0800 Subject: [PATCH 1/7] initial work on easier file dependencies. --- R/fileDependency.R | 42 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 42 insertions(+) create mode 100644 R/fileDependency.R diff --git a/R/fileDependency.R b/R/fileDependency.R new file mode 100644 index 00000000..82352dd8 --- /dev/null +++ b/R/fileDependency.R @@ -0,0 +1,42 @@ +#' Define a file dependency that can be accessed by the client using javascript. +#' @export +fileDependency <- function(filename, version = '0.0.1'){ + htmltools::htmlDependency( + name = basename(tools:::file_path_sans_ext(filename)), + version = version, + src = normalizePath(dirname(filename)), + attachment = basename(filename) + ) +} + +attachment <- function(x){ + structure(x, class = unique(c("ATTACHMENT", oldClass(x)))) +} + +attachmentEvals <- function(list) { + evals <- which(unlist(shouldEval2(list))) + I(evals) # need I() to prevent RJSONIO::toJSON() from converting it to scalar +} + +#' JSON elements that are character with the class JS_EVAL will be evaluated +#' +#' @noRd +#' @keywords internal +shouldEval2 <- function(options) { + if (is.list(options)) { + if ((n <- length(options)) == 0) return(FALSE) + # use numeric indices as names (remember JS indexes from 0, hence -1 here) + if (is.null(names(options))) + names(options) <- seq_len(n) - 1L + # Escape '\' and '.' by prefixing them with '\'. This allows us to tell the + # difference between periods as separators and periods that are part of the + # name itself. + names(options) <- gsub("([\\.])", "\\\\\\1", names(options)) + nms <- names(options) + if (length(nms) != n || any(nms == '')) + stop("'options' must be a fully named list, or have no names (NULL)") + lapply(options, shouldEval2) + } else { + is.character(options) && inherits(options, 'ATTACHMENT') + } +} From 94fb57e8a365478cf722ebc6b86f0752c98a7f6a Mon Sep 17 00:00:00 2001 From: Ramnath Vaidyanathan Date: Wed, 18 Feb 2015 10:31:12 -0800 Subject: [PATCH 2/7] resolve attachment urls automagically! --- inst/www/htmlwidgets.js | 30 ++++++++++++++++++++++++++++++ 1 file changed, 30 insertions(+) diff --git a/inst/www/htmlwidgets.js b/inst/www/htmlwidgets.js index 85564be7..029fc529 100644 --- a/inst/www/htmlwidgets.js +++ b/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, '.', '\\'); From fbad6264c2823f24c7a18620d67cdd815ec52a96 Mon Sep 17 00:00:00 2001 From: Ramnath Vaidyanathan Date: Wed, 18 Feb 2015 10:31:51 -0800 Subject: [PATCH 3/7] add attachments and dependencies for automatic resolution. --- R/htmlwidgets.R | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/R/htmlwidgets.R b/R/htmlwidgets.R index aee0db3f..49d135ed 100644 --- a/R/htmlwidgets.R +++ b/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 From 5f6348b37d8bfb429c2b23d24d3f89901ea6f5bc Mon Sep 17 00:00:00 2001 From: Ramnath Vaidyanathan Date: Wed, 18 Feb 2015 10:32:25 -0800 Subject: [PATCH 4/7] add utility functions to support specification of file dependencies. --- R/fileDependency.R | 40 ++++++++++++---------------------------- 1 file changed, 12 insertions(+), 28 deletions(-) diff --git a/R/fileDependency.R b/R/fileDependency.R index 82352dd8..41b78ab9 100644 --- a/R/fileDependency.R +++ b/R/fileDependency.R @@ -1,42 +1,26 @@ -#' Define a file dependency that can be accessed by the client using javascript. +#' Create a file dependency that can be accessed by the client using javascript. #' @export fileDependency <- function(filename, version = '0.0.1'){ htmltools::htmlDependency( name = basename(tools:::file_path_sans_ext(filename)), version = version, - src = normalizePath(dirname(filename)), + src = dirname(filename), attachment = basename(filename) ) } +#' Mark a string as an attachment +#' @export attachment <- function(x){ - structure(x, class = unique(c("ATTACHMENT", oldClass(x)))) + structure(normalizePath(x), class = unique(c("ATTACHMENT", oldClass(x)))) } -attachmentEvals <- function(list) { - evals <- which(unlist(shouldEval2(list))) - I(evals) # need I() to prevent RJSONIO::toJSON() from converting it to scalar +attachmentDeps <- function(list) { + attachments = rapply(list, function(y){y}, classes = 'ATTACHMENT') + deps = lapply(attachments, fileDependency) + attachments = lapply(as.list(attachments), function(x){ + basename(tools::file_path_sans_ext(x)) + }) + list(attachments = attachments, deps = deps) } -#' JSON elements that are character with the class JS_EVAL will be evaluated -#' -#' @noRd -#' @keywords internal -shouldEval2 <- function(options) { - if (is.list(options)) { - if ((n <- length(options)) == 0) return(FALSE) - # use numeric indices as names (remember JS indexes from 0, hence -1 here) - if (is.null(names(options))) - names(options) <- seq_len(n) - 1L - # Escape '\' and '.' by prefixing them with '\'. This allows us to tell the - # difference between periods as separators and periods that are part of the - # name itself. - names(options) <- gsub("([\\.])", "\\\\\\1", names(options)) - nms <- names(options) - if (length(nms) != n || any(nms == '')) - stop("'options' must be a fully named list, or have no names (NULL)") - lapply(options, shouldEval2) - } else { - is.character(options) && inherits(options, 'ATTACHMENT') - } -} From ed1ba2903981ea84bbe9c8d8498c2438fe633bc6 Mon Sep 17 00:00:00 2001 From: Ramnath Vaidyanathan Date: Wed, 18 Feb 2015 11:34:08 -0800 Subject: [PATCH 5/7] check if the file being attached exists --- R/fileDependency.R | 3 +++ 1 file changed, 3 insertions(+) diff --git a/R/fileDependency.R b/R/fileDependency.R index 41b78ab9..6a1fd37b 100644 --- a/R/fileDependency.R +++ b/R/fileDependency.R @@ -12,6 +12,9 @@ fileDependency <- function(filename, version = '0.0.1'){ #' Mark a string as an attachment #' @export attachment <- function(x){ + if (!file.exists(x)){ + stop("The attachment ", x, " does not exist") + } structure(normalizePath(x), class = unique(c("ATTACHMENT", oldClass(x)))) } From cd9478cec1ef1ef1fe43641288f9c7be620b4a6c Mon Sep 17 00:00:00 2001 From: Ramnath Vaidyanathan Date: Thu, 19 Feb 2015 08:59:16 -0800 Subject: [PATCH 6/7] some minor changes (thanks @yihui) --- R/fileDependency.R | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/R/fileDependency.R b/R/fileDependency.R index 6a1fd37b..f392e9d4 100644 --- a/R/fileDependency.R +++ b/R/fileDependency.R @@ -12,14 +12,14 @@ fileDependency <- function(filename, version = '0.0.1'){ #' Mark a string as an attachment #' @export attachment <- function(x){ - if (!file.exists(x)){ - stop("The attachment ", x, " does not exist") - } - structure(normalizePath(x), class = unique(c("ATTACHMENT", oldClass(x)))) + structure( + normalizePath(x, mustWork = TRUE), + class = unique(c("ATTACHMENT", oldClass(x))) + ) } attachmentDeps <- function(list) { - attachments = rapply(list, function(y){y}, classes = 'ATTACHMENT') + attachments = rapply(list, identity, classes = 'ATTACHMENT') deps = lapply(attachments, fileDependency) attachments = lapply(as.list(attachments), function(x){ basename(tools::file_path_sans_ext(x)) From 04fe1af0b91a9fe529c06f30fed2b7c5d108c03a Mon Sep 17 00:00:00 2001 From: Joe Cheng Date: Thu, 28 May 2015 13:42:04 -0700 Subject: [PATCH 7/7] Enhance attachment() feature to work with dynamic data Without this change, the attachment() feature might return stale data, since it identified file dependencies only by basename. --- NAMESPACE | 6 ++++- R/fileDependency.R | 57 +++++++++++++++++++++++++++++++++++----- R/imports.R | 2 +- man/JS.Rd | 3 ++- man/attachment.Rd | 12 +++++++++ man/createWidget.Rd | 3 ++- man/fileDependency.Rd | 12 +++++++++ man/htmlwidgets-shiny.Rd | 3 ++- man/saveWidget.Rd | 3 ++- man/scaffoldWidget.Rd | 3 ++- man/sizingPolicy.Rd | 3 ++- 11 files changed, 92 insertions(+), 15 deletions(-) create mode 100644 man/attachment.Rd create mode 100644 man/fileDependency.Rd diff --git a/NAMESPACE b/NAMESPACE index 0f6c3b1a..7b20a628 100644 --- a/NAMESPACE +++ b/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) diff --git a/R/fileDependency.R b/R/fileDependency.R index f392e9d4..43b7acf8 100644 --- a/R/fileDependency.R +++ b/R/fileDependency.R @@ -1,8 +1,19 @@ +# 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 = basename(tools:::file_path_sans_ext(filename)), + name = generateFileDependencyKey(filename), version = version, src = dirname(filename), attachment = basename(filename) @@ -13,17 +24,49 @@ fileDependency <- function(filename, version = '0.0.1'){ #' @export attachment <- function(x){ structure( - normalizePath(x, mustWork = TRUE), - class = unique(c("ATTACHMENT", oldClass(x))) + "{attachment}", + class = unique(c("ATTACHMENT", oldClass(x))), + attachmentPath = normalizePath(x, mustWork = TRUE) ) } attachmentDeps <- function(list) { - attachments = rapply(list, identity, classes = 'ATTACHMENT') - deps = lapply(attachments, fileDependency) - attachments = lapply(as.list(attachments), function(x){ - basename(tools::file_path_sans_ext(x)) + # 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) } diff --git a/R/imports.R b/R/imports.R index e8fef1fa..f06ac84c 100644 --- a/R/imports.R +++ b/R/imports.R @@ -1,2 +1,2 @@ -#' @import htmltools RJSONIO +#' @import htmltools RJSONIO bitops digest NULL diff --git a/man/JS.Rd b/man/JS.Rd index 0dc68b22..ee38c24b 100644 --- a/man/JS.Rd +++ b/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} diff --git a/man/attachment.Rd b/man/attachment.Rd new file mode 100644 index 00000000..cd90a49b --- /dev/null +++ b/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 +} + diff --git a/man/createWidget.Rd b/man/createWidget.Rd index e21bf953..b7073b00 100644 --- a/man/createWidget.Rd +++ b/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} diff --git a/man/fileDependency.Rd b/man/fileDependency.Rd new file mode 100644 index 00000000..c97a5256 --- /dev/null +++ b/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. +} + diff --git a/man/htmlwidgets-shiny.Rd b/man/htmlwidgets-shiny.Rd index 84746aff..72b39ba3 100644 --- a/man/htmlwidgets-shiny.Rd +++ b/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} diff --git a/man/saveWidget.Rd b/man/saveWidget.Rd index d4204cbb..14932e25 100644 --- a/man/saveWidget.Rd +++ b/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} diff --git a/man/scaffoldWidget.Rd b/man/scaffoldWidget.Rd index 71b9193e..b0c87763 100644 --- a/man/scaffoldWidget.Rd +++ b/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} diff --git a/man/sizingPolicy.Rd b/man/sizingPolicy.Rd index 97828831..f02993fe 100644 --- a/man/sizingPolicy.Rd +++ b/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}