add the magical servr::httr() function

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: servr
 Type: Package
 Title: A Simple HTTP Server to Serve Static Files or Dynamic Documents
-Version: 0.28.1
+Version: 0.28.2
 Authors@R: c(
   person("Yihui", "Xie", role = c("aut", "cre"), email = "[email protected]", comment = c(ORCID = "0000-0003-0645-5666")),
   person("Carson", "Sievert", role = "ctb"),
@@ -19,7 +19,7 @@ Depends:
 Imports:
     mime (>= 0.2),
     httpuv (>= 1.5.2),
-    xfun,
+    xfun (>= 0.42),
     jsonlite
 Suggests:
     tools,

NAMESPACE

@@ -6,6 +6,7 @@ export(create_server)
 export(daemon_list)
 export(daemon_stop)
 export(httd)
+export(httr)
 export(httw)
 export(jekyll)
 export(make)

NEWS.md

@@ -1,5 +1,7 @@
 # CHANGES IN servr VERSION 0.29
 
+- Added a function `httr()` to run R scripts and show output as HTML pages when serving a directory.
+
 - Added a new argument `response` to `httd()` to post-process the response.
 
 # CHANGES IN servr VERSION 0.28

R/static.R

@@ -50,6 +50,59 @@ httd = function(dir = '.', ..., response = NULL) {
   create_server(dir, ..., handler = serve_dir(dir, response))
 }
 
+#' @details \code{httr()} is based on \code{httr()} with a custom
+#'   \code{response} function that executes R files via \code{xfun::record()},
+#'   so that you will see the output of an R script as an HTML page. The page
+#'   will be automatically updated when the R script is modified and saved.
+#' @rdname httd
+#' @export
+httr = function(dir = '.', ...) {
+  dir = normalizePath(dir, mustWork = TRUE)
+  js = xfun::file_string(pkg_file('ws-update.js'))
+  interval = NULL
+  db = list()  # cache based on mtime of files
+  is_r = function(p) grepl('[.][Rr]$', p)
+  res = httd(dir, ..., response = function(path, res) {
+    if (is_r(path)) {
+      path = sub('^[.]/', '', path)
+      if (is.raw(code <- res$body)) code = sub('\r?\n$', '', rawToChar(code))
+      res$body = run_r(path, code, template = TRUE)
+      db[[path]] <<- file.mtime(path)
+      res$headers[['Content-Type']] = 'text/html'
+      # wait for `interval` to be initialized below
+      while (!is.numeric(interval)) Sys.sleep(.1)
+      res = add_js(res, js, interval, path)
+    }
+    res
+  },
+  ws_open = function(ws) {
+    ws$onMessage(function(binary, message) {
+      owd = setwd(dir); on.exit(setwd(owd), add = TRUE)
+      send = function(x = '') ws$send(x)
+      if (!is.character(p <- message) || !is_r(p)) return(send())
+      t1 = db[[p]]; t2 = file.mtime(p)
+      # skip if the R script has not been updated
+      if (is.null(t1) || t1 >= t2) return(send())
+      db[[p]] <<- t2
+      # send new results onto the HTML page
+      send(tryCatch(run_r(p), error = function(e) {
+        warning(e$message, call. = FALSE, immediate. = TRUE)
+        paste('Error:', e$message)
+      }))
+    })
+  })
+  interval = res$interval
+  invisible(res)
+}
+
+run_r = function(path, code = xfun::read_utf8(path), ...) {
+  res = in_dir(dirname(path), xfun::record(
+    code, dev.path = paste0(xfun::sans_ext(basename(path)), '_files/figure/'),
+    error = TRUE, envir = globalenv()
+  ))
+  paste2(format(res, 'html', ...))
+}
+
 #' @details \code{httw()} is similar to \code{httd()} but watches for changes
 #'   under the directory: if an HTML file is being viewed in the browser, and
 #'   any files are modified under the directory, the HTML page will be

inst/resources/ws-update.js

@@ -0,0 +1,31 @@
+((interval, path) => {
+const ws = new WebSocket(location.href.replace(/^http/, 'ws').replace(/\/?$/, '/websocket/'));
+let flag;
+ws.onmessage = e => {
+  flag = true;
+  if (e.data === '') return;
+  // alert error message
+  if (/^Error:/.test(e.data)) {
+    alert(e.data); return;
+  }
+  // replace the document body
+  document.body.innerHTML = e.data;
+  // re-run JS
+  document.querySelectorAll('script[src]').forEach(el => {
+    const d = document.createElement('script');
+    el.after(d);
+    d.defer = true;
+    d.src = el.src;
+    el.remove();
+  });
+  // reload images by forcing a query param
+  document.querySelectorAll('img').forEach(el => {
+    el.src = el.src + '?t=' + (+new Date());
+  });
+};
+setInterval(() => {
+  if (flag === false || ws.readyState !== ws.OPEN) return;
+  flag = false;  // prevent ws message if R hasn't responded yet
+  ws.send(path);
+}, interval);
+})