19 changed files with 663 additions and 12 deletions
@ -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,"%>%") |
|||
|
|||
@ -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 |
|||
#' |
|||
#' } |
|||
@ -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 |
|||
@ -0,0 +1,90 @@ |
|||
# Less cool counterparts to purrr's side-effect capture-rs |
|||
# |
|||
# Most of the helper functions are 100% from output.R in purrr repo |
|||
# |
|||
# @param quiet Hide errors (`TRUE`, the default), or display them |
|||
# as they occur? |
|||
# @param otherwise Default value to use when an error occurs. |
|||
# |
|||
# @return `safely`: wrapped function instead returns a list with |
|||
# components `result` and `error`. One value is always `NULL`. |
|||
# |
|||
# `quietly`: wrapped function instead returns a list with components |
|||
# `result`, `output`, `messages` and `warnings`. |
|||
# |
|||
# `possibly`: wrapped function uses a default value (`otherwise`) |
|||
# whenever an error occurs. |
|||
safely <- function(.f, otherwise = NULL, quiet = TRUE) { |
|||
function(...) capture_error(.f(...), otherwise, quiet) |
|||
} |
|||
|
|||
quietly <- function(.f) { |
|||
function(...) capture_output(.f(...)) |
|||
} |
|||
|
|||
possibly <- function(.f, otherwise, quiet = TRUE) { |
|||
force(otherwise) |
|||
function(...) { |
|||
tryCatch(.f(...), |
|||
error = function(e) { |
|||
if (!quiet) |
|||
message("Error: ", e$message) |
|||
otherwise |
|||
}, |
|||
interrupt = function(e) { |
|||
stop("Terminated by user", call. = FALSE) |
|||
} |
|||
) |
|||
} |
|||
} |
|||
|
|||
capture_error <- function(code, otherwise = NULL, quiet = TRUE) { |
|||
tryCatch( |
|||
list(result = code, error = NULL), |
|||
error = function(e) { |
|||
if (!quiet) |
|||
message("Error: ", e$message) |
|||
|
|||
list(result = otherwise, error = e) |
|||
}, |
|||
interrupt = function(e) { |
|||
stop("Terminated by user", call. = FALSE) |
|||
} |
|||
) |
|||
} |
|||
|
|||
capture_output <- function(code) { |
|||
warnings <- character() |
|||
wHandler <- function(w) { |
|||
warnings <<- c(warnings, w$message) |
|||
invokeRestart("muffleWarning") |
|||
} |
|||
|
|||
messages <- character() |
|||
mHandler <- function(m) { |
|||
messages <<- c(messages, m$message) |
|||
invokeRestart("muffleMessage") |
|||
} |
|||
|
|||
temp <- file() |
|||
sink(temp) |
|||
on.exit({ |
|||
sink() |
|||
close(temp) |
|||
}) |
|||
|
|||
result <- withCallingHandlers( |
|||
code, |
|||
warning = wHandler, |
|||
message = mHandler |
|||
) |
|||
|
|||
output <- paste0(readLines(temp, warn = FALSE), collapse = "\n") |
|||
|
|||
list( |
|||
result = result, |
|||
output = output, |
|||
warnings = warnings, |
|||
messages = messages |
|||
) |
|||
} |
|||
@ -0,0 +1,23 @@ |
|||
% Generated by roxygen2: do not edit by hand |
|||
% Please edit documentation in R/gepetto.R |
|||
\name{gep_active} |
|||
\alias{gep_active} |
|||
\title{Get test whether the gepetto server is active} |
|||
\usage{ |
|||
gep_active(gep) |
|||
} |
|||
\arguments{ |
|||
\item{gep}{a gepetto connection object} |
|||
} |
|||
\value{ |
|||
logical (\code{TRUE} if alive) |
|||
} |
|||
\description{ |
|||
Get test whether the gepetto server is active |
|||
} |
|||
\examples{ |
|||
\dontrun{ |
|||
gepetto() \%>\% |
|||
gep_active() |
|||
} |
|||
} |
|||
@ -0,0 +1,24 @@ |
|||
% Generated by roxygen2: do not edit by hand |
|||
% Please edit documentation in R/gepetto.R |
|||
\name{gep_debug} |
|||
\alias{gep_debug} |
|||
\title{Get "debug-level" information of a running gepetto server} |
|||
\usage{ |
|||
gep_debug(gep) |
|||
} |
|||
\arguments{ |
|||
\item{gep}{a gepetto connection object} |
|||
} |
|||
\value{ |
|||
debug info |
|||
} |
|||
\description{ |
|||
Get "debug-level" information of a running gepetto server |
|||
} |
|||
\examples{ |
|||
\dontrun{ |
|||
gepetto() \%>\% |
|||
gep_debug() \%>\% |
|||
str() |
|||
} |
|||
} |
|||
@ -0,0 +1,30 @@ |
|||
% Generated by roxygen2: do not edit by hand |
|||
% Please edit documentation in R/gepetto.R |
|||
\name{gep_render_har} |
|||
\alias{gep_render_har} |
|||
\title{Render a page in a javascript context and serialize to HAR} |
|||
\usage{ |
|||
gep_render_har(gep, url, width = 1440, height = 5000) |
|||
} |
|||
\arguments{ |
|||
\item{gep}{a gepetto connection object} |
|||
|
|||
\item{url}{the URL to fetch and render} |
|||
|
|||
\item{width, height}{viewport width/height} |
|||
} |
|||
\value{ |
|||
HAR |
|||
} |
|||
\description{ |
|||
TODO: Modify the \code{puppeteer-har} node module to allow for saving content |
|||
} |
|||
\note{ |
|||
content is not returned, just HAR information |
|||
} |
|||
\examples{ |
|||
\dontrun{ |
|||
gepetto(port=3000) \%>\% |
|||
gep_render_har("https://r-project.org/") |
|||
} |
|||
} |
|||
@ -0,0 +1,27 @@ |
|||
% Generated by roxygen2: do not edit by hand |
|||
% Please edit documentation in R/gepetto.R |
|||
\name{gep_render_html} |
|||
\alias{gep_render_html} |
|||
\title{Render a page in a javascript context and serialize to HTML} |
|||
\usage{ |
|||
gep_render_html(gep, url, width = 1440, height = 5000) |
|||
} |
|||
\arguments{ |
|||
\item{gep}{a gepetto connection object} |
|||
|
|||
\item{url}{the URL to fetch and render} |
|||
|
|||
\item{width, height}{viewport width/height} |
|||
} |
|||
\value{ |
|||
HTML |
|||
} |
|||
\description{ |
|||
Render a page in a javascript context and serialize to HTML |
|||
} |
|||
\examples{ |
|||
\dontrun{ |
|||
gepetto(port=3000) \%>\% |
|||
gep_render_html("https://r-project.org/") |
|||
} |
|||
} |
|||
@ -0,0 +1,27 @@ |
|||
% Generated by roxygen2: do not edit by hand |
|||
% Please edit documentation in R/gepetto.R |
|||
\name{gep_render_magick} |
|||
\alias{gep_render_magick} |
|||
\title{Render a page in a javascript context and take a screenshot} |
|||
\usage{ |
|||
gep_render_magick(gep, url, width = 1440, height = 5000) |
|||
} |
|||
\arguments{ |
|||
\item{gep}{a gepetto connection object} |
|||
|
|||
\item{url}{the URL to fetch and render} |
|||
|
|||
\item{width, height}{viewport width/height} |
|||
} |
|||
\value{ |
|||
\code{magick} image |
|||
} |
|||
\description{ |
|||
Render a page in a javascript context and take a screenshot |
|||
} |
|||
\examples{ |
|||
\dontrun{ |
|||
gepetto(port=3000) \%>\% |
|||
gep_render_magick("https://r-project.org/") |
|||
} |
|||
} |
|||
@ -0,0 +1,33 @@ |
|||
% Generated by roxygen2: do not edit by hand |
|||
% Please edit documentation in R/gepetto.R |
|||
\name{gep_render_pdf} |
|||
\alias{gep_render_pdf} |
|||
\title{Render a page in a javascript context and rendero to PDF} |
|||
\usage{ |
|||
gep_render_pdf(gep, url, path = NULL, overwrite = TRUE, width = 1440, |
|||
height = 5000) |
|||
} |
|||
\arguments{ |
|||
\item{gep}{a gepetto connection object} |
|||
|
|||
\item{url}{the URL to fetch and render} |
|||
|
|||
\item{path}{directory & filename to save the PDF to. If \code{NULL} will be saved |
|||
to a tempfile and it location will be returned.} |
|||
|
|||
\item{overwrite}{if \code{TRUE} any existing \code{path} (file) will be overwritten} |
|||
|
|||
\item{width, height}{viewport width/height} |
|||
} |
|||
\value{ |
|||
object |
|||
} |
|||
\description{ |
|||
Render a page in a javascript context and rendero to PDF |
|||
} |
|||
\examples{ |
|||
\dontrun{ |
|||
gepetto(port=3000) \%>\% |
|||
gep_render_pdf("https://r-project.org/") |
|||
} |
|||
} |
|||
@ -0,0 +1,27 @@ |
|||
% Generated by roxygen2: do not edit by hand |
|||
% Please edit documentation in R/gepetto.R |
|||
\name{gepetto} |
|||
\alias{gepetto} |
|||
\title{Create a connection to a Gepetto API server} |
|||
\usage{ |
|||
gepetto(host = "localhost", port = 8080) |
|||
} |
|||
\arguments{ |
|||
\item{host}{where is it running? Defaults to "\code{localhost}"} |
|||
|
|||
\item{port}{same, but what port? Defaults to \code{8080} since the most common |
|||
use case is that you have \code{gepetto} running in a Docker container. |
|||
Use \code{3000} if you're running it locally via \code{npm} as that's the default |
|||
port for development.`} |
|||
} |
|||
\value{ |
|||
A \code{gepetto} connection object |
|||
} |
|||
\description{ |
|||
Create a connection to a Gepetto API server |
|||
} |
|||
\examples{ |
|||
\dontrun{ |
|||
gepetto() |
|||
} |
|||
} |
|||
@ -0,0 +1,12 @@ |
|||
% Generated by roxygen2: do not edit by hand |
|||
% Please edit documentation in R/utils-pipe.R |
|||
\name{\%>\%} |
|||
\alias{\%>\%} |
|||
\title{Pipe operator} |
|||
\usage{ |
|||
lhs \%>\% rhs |
|||
} |
|||
\description{ |
|||
See \code{magrittr::\link[magrittr]{\%>\%}} for details. |
|||
} |
|||
\keyword{internal} |
|||
@ -0,0 +1,17 @@ |
|||
% Generated by roxygen2: do not edit by hand |
|||
% Please edit documentation in R/gepetto.R |
|||
\name{print.gepetto} |
|||
\alias{print.gepetto} |
|||
\title{Print} |
|||
\usage{ |
|||
\method{print}{gepetto}(x, ...) |
|||
} |
|||
\arguments{ |
|||
\item{x}{\code{gepetto} object} |
|||
|
|||
\item{...}{unused} |
|||
} |
|||
\description{ |
|||
Print |
|||
} |
|||
\keyword{internal} |
|||
Loading…
Reference in new issue