#' @title Generic crrry methods
CrrryGeneric <- R6::R6Class(
"CrrryGeneric",
public = list(
#' @field process Chrome process, frm `{crrri}`
process = NULL,
#' @description
#' Execute JavaScript code in the session.
#' @param code JS code
#' @param check Should `{crrry}` check if Shiny is still running?
call_js = function(code, check = TRUE){
cli::cat_rule(
sprintf("Launching JS: %s", code)
)
res <- crrri::hold({
private$Runtime$evaluate(
expression = code
)
})
maybe_check(check, private)
invisible(res)
},
#' @description
#' Click on an id
#' @param id ID
#' @param check Should `{crrry}` check if Shiny is still running?
click_on_id = function(id, check = TRUE){
cli::cat_rule(
sprintf("Clicking on id: %s", id)
)
crrri::hold({
private$Runtime$evaluate(
expression = sprintf(
'document.getElementById("%s").click()',
id
)
)
})
maybe_check(check, private)
},
#' @description
#' Send a `gremlin.js` horde
#' @param check Should `{crrry}` check if Shiny is still running?
gremlins_horde = function(check = TRUE){
cli::cat_rule(
"Sending hordes of gremlins"
)
# https://github.com/marmelab/gremlins.js
crrri::hold({
private$Runtime$evaluate(
expression = '(function() {
function callback() {
gremlins.createHorde({
species: [gremlins.species.clicker(),gremlins.species.toucher(),gremlins.species.formFiller(),gremlins.species.scroller(),gremlins.species.typer()],
mogwais: [gremlins.mogwais.alert(),gremlins.mogwais.fps(),gremlins.mogwais.gizmo()],
strategies: [gremlins.strategies.distribution()]
}).unleash();
}
var s = document.createElement("script");
s.src = "https://unpkg.com/gremlins.js";
if (s.addEventListener) {
s.addEventListener("load", callback, false);
} else if (s.readyState) {
s.onreadystatechange = callback;
}
document.body.appendChild(s);
})()'
)
})
maybe_check(check, private)
},
#' @description
#' Set the value of a shiny input
#' @param id Shiny ID
#' @param val Value for the ID
#' @param check Should `{crrry}` check if Shiny is still running?
shiny_set_input = function(id, val, check = TRUE){
cli::cat_rule(
sprintf("Setting id %s with value %s", id, val)
)
crrri::hold({
private$Runtime$evaluate(
expression = sprintf(
'Shiny.setInputValue("%s", "%s")',
id, val
)
)
})
maybe_check(check, private)
},
#' @description
#' Wait for Shiny to be ready
#' @param check Should `{crrry}` check if Shiny is still running?
wait_for_shiny_ready = function(check = TRUE){
sleep_while_shiny_busy(private$Runtime)
if(check){
check_still_running(private$Runtime)
}
},
#' @description
#' Wait for a JS condition to be TRUE
#' @param cond JS condition
#' @param check Should `{crrry}` check if Shiny is still running?
wait_for = function(cond, check = TRUE){
sleep_while(cond, private$Runtime)
if(check){
check_still_running(private$Runtime)
}
}
),
private = list(
chrome = NULL,
Page = NULL,
Runtime = NULL,
client = NULL
)
)
#' @title Launch a crrrry on a webpage
#'
#' @return A crrrry object
#'
#' @export
CrrryOnPage <- R6::R6Class(
"CrrryOnPage",
inherit = CrrryGeneric,
public = list(
#' @description
#' Create a Chrome object that connect to an URL with a Shiny App
#' @param chrome_bin Path to Chrome binary, passed to `Chrome$new()`
#' @param url URL where the app is running
#' @param chrome_port Chrome_port, passed to `Chrome$new()`
#' @param headless Run headless? Passed to `Chrome$new()`
#' @param ... Futher args passed to `Chrome$new()`
initialize = function(
chrome_bin = Sys.getenv("HEADLESS_CHROME"),
chrome_port = 9222L,
url,
headless = headless,
...
){
private$chrome <- crrri::Chrome$new(
chrome_bin,
debug_port = chrome_port,
headless = headless,
...
)
private$client <- crrri::hold(
private$chrome$connect()
)
private$Page <- private$client$Page
private$Runtime <- private$client$Runtime
crrri::hold({
private$client$Page$navigate(
url = url
)
})
},
#' @description
#' Stop the process
stop = function(){
private$chrome$close()
},
#' @description
#' Check if the url is available
is_alive = function(){
attr( curlGetHeaders(url), "status" ) == 200
}
)
)
#' @title Launch a crrrry on a local process
#'
#' @return A crrrry object
#'
#' @export
CrrryProc <- R6::R6Class(
"CrrryOnPage",
inherit = CrrryGeneric,
public = list(
#' @description
#' Get the process stdout
stdout = function(){
cat(
readLines(private$stdout_),
sep = "\n"
)
},
#' @description
#' Get the process stderr
stderr = function(){
cat(
readLines(private$stderr_),
sep = "\n"
)
},
#' @description
#' Wait for a JS condition to be TRUE
#' @param chrome_bin Path to Chrome binary, passed to `Chrome$new()`
#' @param fun A function launching the shiny app
#' @param shiny_port The port to launch the shiny apps on
#' @param chrome_port Chrome_port, passed to `Chrome$new()`
#' @param headless Run headless? Passed to `Chrome$new()`
#' @param pre_launch_cmd Code to launch before `fun`.
#' @param ... Futher args passed to `Chrome$new()`
initialize = function(
chrome_bin = Sys.getenv("HEADLESS_CHROME"),
fun = "pkgload::load_all();run_app()",
shiny_port = 2811L,
chrome_port = 9222L,
headless = TRUE,
pre_launch_cmd = "",
...
){
#browser()
private$stdout_ <- tempfile()
private$stderr_ <- tempfile()
attempt::stop_if(
pre_launch_cmd,
is.null,
'pre_launch_cmd can not be NULL. If you want it empty, use `""` (the default).'
)
self$process <- processx::process$new(
"Rscript", c(
"-e",
sprintf(
"options(shiny.port = %s, shiny.launch.browser = invisible);%s;%s",
shiny_port, pre_launch_cmd, fun
)
),
stderr = private$stderr_,
stdout = private$stdout_
)
attempt::stop_if_not(
self$process$is_alive(),
msg = "Unable to launch the Shiny App"
)
private$chrome <- crrri::Chrome$new(
chrome_bin,
debug_port = chrome_port,
headless = headless,
...
)
private$client <- crrri::hold(
private$chrome$connect()
)
private$Page <- private$client$Page
private$Runtime <- private$client$Runtime
crrri::hold({
private$client$Page$navigate(
url = sprintf(
"http://127.0.0.1:%s",
shiny_port
)
)
})
},
#' @description
#' Stop the process
stop = function(){
self$process$kill()
private$chrome$close()
},
#' @description
#' Check if the url is available
is_alive = function(){
self$process$is_alive()
}
), private = list(
stdout_ = character(0),
stderr_ = character(0)
)
)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.