gepetto sneak peek

DESCRIPTION

@@ -23,9 +23,13 @@ Suggests:
 Depends:
     R (>= 3.2.0)
 Imports:
+    httr,
+    jsonlite,
+    HARtools,
     xml2,
     magick,
     processx,
     tools,
-    utils
+    utils,
+    magrittr
 RoxygenNote: 6.0.1.9000

NAMESPACE

@@ -1,14 +1,27 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(print,gepetto)
+export("%>%")
 export(chrome_dump_pdf)
 export(chrome_read_html)
 export(chrome_shot)
 export(chrome_version)
 export(download_chromium)
+export(gep_active)
+export(gep_debug)
+export(gep_render_har)
+export(gep_render_html)
+export(gep_render_magick)
+export(gep_render_pdf)
+export(gepetto)
 export(get_chrome_env)
 export(set_chrome_env)
+import(httr)
 import(magick)
 import(processx)
 import(tools)
 import(utils)
 import(xml2)
+importFrom(HARtools,readHAR)
+importFrom(jsonlite,fromJSON)
+importFrom(magrittr,"%>%")

R/decapitated-package.R

@@ -44,5 +44,7 @@
 #' @name decapitated
 #' @docType package
 #' @author Bob Rudis (bob@@rud.is)
-#' @import xml2 magick processx tools utils
+#' @import xml2 magick processx tools utils httr
+#' @importFrom jsonlite fromJSON
+#' @importFrom HARtools readHAR
 NULL

R/gepetto.R

@@ -0,0 +1,279 @@
+#' Create a connection to a Gepetto API server
+#'
+#' @md
+#' @param host where is it running? Defaults to "`localhost`"
+#' @param port same, but what port? Defaults to `8080` since the most common
+#'        use case is that you have `gepetto` running in a Docker container.
+#'        Use `3000` if you're running it locally via `npm` as that's the default
+#'        port for development.`
+#' @return A `gepetto` connection object
+#' @export
+#' @examples \dontrun{
+#' gepetto()
+#' }
+gepetto <- function(host = "localhost", port = 8080) {
+
+  list(
+    host = host,
+    port = port
+  ) -> out
+
+  class(out) <- c("gepetto")
+
+  out
+
+}
+
+#' Print
+#' @md
+#' @param x `gepetto` object
+#' @param ... unused
+#' @keywords internal
+#' @export
+print.gepetto <- function(x, ...) {
+  cat("<gepetto@", x$host, ":", x$port, ">\n", sep="")
+}
+
+#' Render a page in a javascript context and serialize to HTML
+#'
+#' @md
+#' @param gep a gepetto connection object
+#' @param url the URL to fetch and render
+#' @param width,height viewport width/height
+#' @return HTML
+#' @export
+#' @examples \dontrun{
+#' gepetto(port=3000) %>%
+#'   gep_render_html("https://r-project.org/")
+#' }
+gep_render_html <- function(gep, url, width=1440, height=5000) {
+
+  httr::GET(
+    url = sprintf("http://%s:%s/render_html", gep$host, gep$port),
+    query = list(
+      url = url,
+      width = width,
+      height = height
+    )
+
+  ) -> res
+
+  httr::stop_for_status(res)
+
+  out <- httr::content(res, as="text")
+  out <- xml2::read_html(out)
+
+  out
+
+}
+
+#' Render a page in a javascript context and serialize to HAR
+#'
+#' TODO: Modify the `puppeteer-har` node module to allow for saving content
+#'
+#' @md
+#' @param gep a gepetto connection object
+#' @param url the URL to fetch and render
+#' @param width,height viewport width/height
+#' @return HAR
+#' @note content is not returned, just HAR information
+#' @export
+#' @examples \dontrun{
+#' gepetto(port=3000) %>%
+#'   gep_render_har("https://r-project.org/")
+#' }
+gep_render_har <- function(gep, url, width=1440, height=5000) {
+
+  httr::GET(
+    url = sprintf("http://%s:%s/render_har", gep$host, gep$port),
+    query = list(
+      url = url,
+      width = width,
+      height = height
+    )
+  ) -> res
+
+  httr::stop_for_status(res)
+
+  out <- httr::content(res, as="text")
+  out <- HARtools::readHAR(out)
+
+  out
+
+}
+
+#' Render a page in a javascript context and take a screenshot
+#'
+#' @md
+#' @param gep a gepetto connection object
+#' @param url the URL to fetch and render
+#' @param width,height viewport width/height
+#' @return `magick` image
+#' @export
+#' @examples \dontrun{
+#' gepetto(port=3000) %>%
+#'   gep_render_magick("https://r-project.org/")
+#' }
+gep_render_magick <- function(gep, url, width=1440, height=5000) {
+ httr::GET(
+   url = sprintf("http://%s:%s/render_png", gep$host, gep$por),
+   query = list(
+     url = url,
+     width = width,
+     height = height
+   )
+ ) -> res
+ httr::stop_for_status(res)
+ out <- httr::content(res)
+ out <- magick::image_read(out)
+ out
+}
+
+# #' Take a screenshot of the current browser page
+# #'
+# #' @md
+# #' @param gep a gepetto connection object
+# #' @return `magick` image
+# #' @export
+# #' @examples \dontrun{
+# #' gepetto(port=3000) %>%
+# #'   gep_screenshot()
+# #' }
+# gep_screenshot <- function(gep) {
+#
+#   httr::GET(
+#     url = sprintf("http://%s:%s/screenshot", gep$host, gep$por),
+#   ) -> res
+#
+#   httr::stop_for_status(res)
+#
+#   out <- httr::content(res)
+#   out <- magick::image_read(out)
+#   out
+#
+# }
+
+#' Render a page in a javascript context and rendero to PDF
+#'
+#' @md
+#' @param gep a gepetto connection object
+#' @param url the URL to fetch and render
+#' @param path directory & filename to save the PDF to. If `NULL` will be saved
+#'        to a tempfile and it location will be returned.
+#' @param overwrite if `TRUE` any existing `path` (file) will be overwritten
+#' @param width,height viewport width/height
+#' @return object
+#' @export
+#' @examples \dontrun{
+#' gepetto(port=3000) %>%
+#'   gep_render_pdf("https://r-project.org/")
+#' }
+gep_render_pdf <- function(gep, url, path=NULL, overwrite=TRUE, width=1440, height=5000) {
+
+  if (is.null(path)) {
+    path <- tempfile(fileext = ".pdf")
+  } else {
+    path <- path.expand(path)
+  }
+
+  httr::GET(
+    url = sprintf("http://%s:%s/render_pdf", gep$host, gep$por),
+    query = list(
+      url = url,
+      width = width,
+      height = height
+    ),
+    httr::write_disk(path = path)
+  ) -> res
+
+  httr::stop_for_status(res)
+
+  path
+
+}
+
+#' Get "debug-level" information of a running gepetto server
+#'
+#' @md
+#' @param gep a gepetto connection object
+#' @return debug info
+#' @export
+#' @examples \dontrun{
+#' gepetto() %>%
+#'   gep_debug() %>%
+#'   str()
+#' }
+gep_debug <- function(gep) {
+
+  httr::GET(
+    url = sprintf("http://%s:%s/_debug", gep$host, gep$port)
+  ) -> res
+
+  httr::stop_for_status(res)
+
+  out <- httr::content(res, as="text")
+  out <- jsonlite::fromJSON(out)
+
+  out
+
+}
+
+#' Get test whether the gepetto server is active
+#'
+#' @md
+#' @param gep a gepetto connection object
+#' @return logical (`TRUE` if alive)
+#' @export
+#' @examples \dontrun{
+#' gepetto() %>%
+#'   gep_active()
+#' }
+gep_active <- function(gep) {
+
+  s_GET(
+    url = sprintf("http://%s:%s/_ping", gep$host, gep$port)
+  ) -> res
+
+  res <- stop_for_problem(res)
+
+  httr::stop_for_status(res)
+
+  out <- httr::content(res, as="text")
+  out <- jsonlite::fromJSON(out)
+
+  out$status == "ok"
+
+}
+
+
+#' #' Execute Puppeteer commands
+#' #'
+#' #' This is a **low-level** call that makes **you** responsible for the return
+#' #' type. Eventually there will likely be more boilerplate code for handling return
+#' #' values.
+#' #'
+#' #' @md
+#' #' @param gep a gepetto connection object
+#' #' @param js Puppeteer js to execute in-browser
+#' #' @references [Puppeteer API](https://github.com/GoogleChrome/puppeteer/blob/v1.7.0/docs/api.md)
+#' #' @export
+#' #' @examples \dontrun{
+#' #' gepetto() %>%
+#' #'   gep_exec()
+#' #' }
+#' gep_exec <- function(gep, js) {
+#'
+#'   httr::POST(
+#'     url = sprintf("http://%s:%s/exec", gep$host, gep$port),
+#'     encode = "form",
+#'     body = js
+#'   ) -> res
+#'
+#'   httr::stop_for_status(res)
+#'
+#'   out <- httr::content(res, as="text")
+#'   #   out <- jsonlite::fromJSON(out)
+#'   #
+#'   out
+#'
+#' }

R/util.r

@@ -1,3 +1,8 @@
+
+stop_for_problem <- function(res) {
+  if (is.null(res$result)) stop(res$error$message, call.=FALSE) else res$result
+}
+
 .get_app_dir <- function() {
   ddir <- file.path(Sys.getenv("HOME"), ".rdecapdata")
   if (!dir.exists(ddir)) {

R/utils-pipe.R

@@ -0,0 +1,11 @@
+#' Pipe operator
+#'
+#' See \code{magrittr::\link[magrittr]{\%>\%}} for details.
+#'
+#' @name %>%
+#' @rdname pipe
+#' @keywords internal
+#' @export
+#' @importFrom magrittr %>%
+#' @usage lhs \%>\% rhs
+NULL