Add archieml htmlwidget

.travis.yml

@@ -13,7 +13,7 @@ addons:
       - libv8-dev
 
 r_github_packages:
-  - noamross/pkgdown
+  - r-lib/pkgdown
 
 after_success:
   - Rscript -e 'covr::codecov()'

DESCRIPTION

@@ -23,6 +23,8 @@ Imports:
     V8,
     jsonlite
 Suggests:
+    htmlwidgets,
+    htmltools,
     testthat,
     covr,
     googledrive,

NAMESPACE

@@ -1,6 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
 export(aml_to_json)
+export(archieml)
 export(from_aml)
 export(from_archie)
 importFrom(V8,new_context)

NEWS.md

@@ -1,5 +1,8 @@
 # rchie *development version*
 
+-  Added htmlwidget to render AML from a remote source in-browser, so that
+   edits in a Google Doc source will update wihtout needing to re-render the
+   R Markdown document
 -  Switched to development version of googledrive and change
    associateed auth setup
 

R/from_aml.R

@@ -91,7 +91,7 @@ aml_to_json <- function(aml, pretty = FALSE, indent = 4) {
   aml <- read_aml(aml)
   aml <- paste(aml, collapse = "\n")
   ct <- new_context()
-  ct$source(system.file("archieml-js/archieml.js", package = "rchie"))
+  ct$source(system.file("htmlwidgets","archieml-js", "archieml.js", package = "rchie"))
   ct$assign("aml", aml)
   json <- ct$eval("JSON.stringify(archieml.load(aml));")
   class(json) <- "json"

R/widget.R

@@ -0,0 +1,65 @@
+#' Inject text into an HTML document from an AML source
+#'
+#' This [**htmlwidget**](https://www.htmlwidgets.org/) prints text from a field
+#' in a source AML document.
+#'
+#' @details A common source for the AML is a Google Document, which should be
+#' accssed via its plain-text URL:
+#' `https://docs.google.com/document/export?format=txt&id=DOCUMENT_ID`.  The
+#' document will need to be publicly viewable for this to work.  Future versions
+#' may enable authorized viewing via Google log-in. Note that due to security
+#' limitations on cross-domain requests in most browsers, this will not work
+#' when viewing a file locally, but it will when hosted on the web.
+#'
+#' @param key the key of the object in the ArchieML document. Nested elements
+#'   can be accessed with length > 1 keys such as `c("top-level",
+#'   "next-level")`.
+#' @param src the URL of the source document. If NULL, the widget will attempt
+#'   to use `params$aml_source`, which can be set in the YAML metadata of an R
+#'   Markdown document (see
+#'   [here](https://bookdown.org/yihui/rmarkdown/params-declare.html)).
+#' @param markdown Should the contents of the AML field be processed as
+#'   markdown? Defaults to TRUE, in which case text is processed with
+#'   [markdown-it](https://github.com/markdown-it/markdown-it).
+#' @param inline If TRUE, markdown will be processed only inline, without any
+#' `<p>` tags. Useful if you are inserting into a paragaph of text or figure.
+#' @param fallback Text to use should the AML source or field not be found.
+#' @param elementId If set, give the element this name. `params$aml_source`, so you
+#'   can set `aml_source:` in the `params:` section of the YAML header of a
+#'   parameterized report.
+#' @export
+archieml <- function(key = NULL, src = NULL, markdown = TRUE, inline = FALSE,
+                     fallback = NULL,  elementId = NULL) {
+  if (!requireNamespace("htmlwidgets")) {
+    stop("The htmlwidgets package is required to use this function.")
+  }
+
+  if (is.null(src) && !exists("params")) {
+    stop("No ArchieML source specified")
+  } else if (is.null(src) && is.null(get("params")[["aml_source"]])) {
+    stop("No ArchieML source specified")
+  } else if (is.null(src)) {
+    src <- get("params")[["aml_source"]]
+  }
+
+    # forward options using x
+  x = list(
+    src = src,
+    key = as.list(key),
+    markdown = markdown,
+    inline = inline,
+    fallback = fallback
+    )
+
+  # create widget
+  htmlwidgets::createWidget(
+    name = 'archieml',
+    x,
+    package = 'rchie',
+    elementId = elementId
+  )
+}
+
+archieml_html <- function(id, style, class, ...){
+  htmltools::tags$span(id = id, class = class)
+}

inst/htmlwidgets/archieml.js

@@ -0,0 +1,51 @@
+replace_el = (obj, key, el, markdown, inline, md) => {
+  for (var i in key) {
+    obj = obj[key[i]];
+  }
+  if (markdown) {
+    if (inline) {
+      obj = md.renderInline(obj);
+    } else {
+      obj = md.render(obj);
+    }
+  }
+  el.innerHTML = obj;
+};
+
+render_archieml_cache = () => {
+  let cache = {};
+  let md = window.markdownit();
+  return (el, src, key, markdown, inline) => {
+    if (cache[src]) {
+      replace_el(cache[src], key, el, markdown, inline, md);
+    } else {
+      var xhttp = new XMLHttpRequest();
+      xhttp.onreadystatechange = function() {
+        if (this.readyState == 4 && this.status == 200) {
+          cache[src] = archieml.load(xhttp.responseText);
+          replace_el(cache[src], key, el, markdown, inline, md);
+        }
+      };
+      xhttp.open("GET", src, true);
+      xhttp.send();
+    }
+  };
+};
+
+render_archieml = render_archieml_cache();
+
+
+HTMLWidgets.widget({
+  name: 'archieml',
+  type: 'output',
+
+  factory: function(el, width, height) {
+    return {
+      renderValue: function(x) {
+        el.innerText = x.fallback;
+        render_archieml(el, x.src, x.key, x.markdown, x.inline);
+      },
+      resize: function(width, height) {}
+    };
+  }
+});

inst/htmlwidgets/archieml.yaml

@@ -0,0 +1,9 @@
+dependencies:
+ - name: archieml-js
+   version: 0.4.2
+   src: htmlwidgets/archieml-js
+   script: archieml.js
+ - name: markdown-it
+   version: 8.4.2
+   src: htmlwidgets/markdown-it
+   script: markdown-it.min.js

tests/testthat/test-widget.R

@@ -0,0 +1,21 @@
+if (requireNamespace("htmlwidgets") && requireNamespace("htmltools") &&
+    requireNamespace("googledrive") && Sys.getenv("RCHIE_DRIVE_KEY") != "") {
+
+  context("widget")
+  library(googledrive)
+  drive_deauth()
+  drive_auth_config(api_key = Sys.getenv("RCHIE_DRIVE_KEY"))
+  gurl <- "https://docs.google.com/document/export?format=txt&id=1oYHXxvzscBBSBhd6xg5ckUEZo3tLytk9zY0VV_Y7SGs"
+  test_that( "archieml makes a htmlwidget ", {
+    expect_is( archieml(key = "key", src = gurl), "htmlwidget" )
+  })
+
+
+  test_that("options passed as expected", {
+    key = "key"
+    obj <- archieml(key = key, src = gurl)
+    expect_identical( obj$x, list(src = gurl, key = as.list(key), markdown = TRUE,
+                                  inline = FALSE, fallback = NULL))
+
+  })
+}