Nothing
#' Websocket for 'sketch' applications
#'
#' @description This combines the *-Server family of functions in 'httpuv'
#' with the transpilation functionality provided by 'sketch'.
#'
#' @export
websocket <- R6::R6Class("websocket", public = list(
#' @field app A list of functions that define the application.
app = NULL,
#' @field server A server handle to be used by 'stopServer'.
server = NULL,
#' @field log A character vector that keep tracks of all the commands
#' sent to the browser session.
log = c(),
#' @field ws A WebSocket channel to handle the communication between
#' the R session and the browser session.
ws = NULL,
#' @field in_handler A function to handle instructions sent by the
#' browser session.
in_handler = NULL,
#' @field out_handler A function to handle instruction sent to the
#' browser session.
out_handler = NULL,
#' @field env An environment to store variables temporarily.
env = new.env(),
#' @field port An integer; the TCP port number.
port = 9454,
#' @field message TRUE or FALSE; whether to display a prompt when
#' a server is started and when it is stopped.
message = TRUE,
#' @field connected TRUE or FALSE; whether a connection has been established.
#' One should ways start the WebSocket server before visiting the web page
#' that connects to the server.
connected = FALSE,
#' @field started TRUE or FALSE; whether a server has been started. Use
#' the \code{startServer} method to start a server.
started = FALSE,
#' @description Start a WebSocket server
startServer = function() {
if (self$started) {
message("There is an existing server running.")
return(invisible(NULL))
}
# Start the server if not already started
self$server <- httpuv::startServer("0.0.0.0", self$port, self$app, 250)
if (self$message) message("Server started.")
self$started <- TRUE
},
#' @description Stop a WebSocket server
stopServer = function() {
if (!self$started) {
message("There is no server running.")
return(invisible(NULL))
}
# Stop the server if not already stopped
httpuv::stopServer(self$server)
if (self$message) message("Server stopped.")
self$started <- FALSE
self$connected <- FALSE
},
#' @description List all running WebSocket servers
listServers = function() {
res <- httpuv::listServers()
message(glue::glue("{length(res)} server(s) is/are running."))
return(res)
},
#' @description Stop all running WebSocket servers
stopAllServers = function() {
httpuv::stopAllServers()
self$started <- FALSE
self$connected <- FALSE
self$listServers()
},
#' @description Enter sketch mode, in which all commands go through
#' the transpiler before reaching the browser session.
sketch_mode = function() {
if (!self$started) {
message("No server is running.")
return(invisible(NULL))
}
if (!self$connected) { # nocov start
message("No connection has been established.")
return(invisible(NULL))
}
cat("(Type `q()` to exit sketch mode)")
while (TRUE) {
input <- read_multilines("sketch > ")
# Ensure `q()` is used appropriately
quit <- rlang::parse_exprs(input) %>%
purrr::map_lgl(~deparse1(.x) == "q()")
if (any(quit)) {
if (length(quit) == 1) break
cat("`q()` must be used standalone.", "\n")
next
}
self$log <- c(self$log, input)
purrr::walk(self$out_handler(input), ~self$ws$send(.x))
} # nocov end
},
#' @description Create a blank HTML page with interactive access.
#' This function is designed for newcomers.
#'
#' @param preamble (Optional) A named list; the preamble to include.
#' Use the name 'lib' for arguments to \code{load_library}, 'script'
#' for arguments to \code{load_script} and 'data' for arguments to
#' \code{load_data}. Note that the "dom" and "websocket" modules are
#' required and loaded by default.
#' @param ... Extra parameters to pass to \link{source_r}.
#'
#' @return The (invisible) temporary file path to the app.
new_app = function(preamble = list(library = c(), script = c(), data = c()), ...) { # nocov start
preamble_to_string <- function(preamble) {
list(names(preamble), preamble) %>%
purrr::pmap(~glue::glue('#| load_{..1}("{..2}")')) %>%
unlist()
}
temp_file <- tempfile(fileext = ".R")
preamble$library <- unique(c("dom", "websocket", preamble$library))
preamble %>%
preamble_to_string() %>%
writeLines(temp_file)
source_r(temp_file, ...)
}, # nocov end
#' @description Initialise a WebSocket connection
#'
#' @param in_handler A function to handle incoming message, default to
#' be \link[base:print]{print} which only displays the message without
#' any processing.
#' @param out_handler A function to handle outgoing message, default to
#' be \link{compile_exprs} which transpiles R commands into JavaScript
#' commands.
#' @param message TRUE or FALSE; whether to display a prompt when
#' a server is started and when it is stopped.
#' @param port An integer; the TCP port number.
#'
#' @return A 'websocket' object.
#'
#' @examples
#' \dontrun{
#' # Launch a WebSocket server
#' ws <- websocket$new()
#' ws$startServer()
#' ws$listServers() # Check that a server is running
#'
#' # Launch a 'sketch' application with WebSocket functionality
#' file <- system.file("test_files/test_websocket.R", package = "sketch")
#' source_r(file, debug = TRUE) # Launch the default browser
#'
#' # Enter sketch mode to send commands to the application
#' ws$sketch_mode()
#' # Within sketch mode
#' print("1234")
#' x <- 10
#' print(x + 1)
#' q()
#'
#' # Back to normal mode, inspect the log and stop the server
#' ws$log
#' ws$stopServer()
#' ws$listServers() # Confirm no server is running
#' }
initialize = function(in_handler, out_handler, message = TRUE, port = 9454) {
if (missing(in_handler)) {
in_handler <- purrr::compose(print, jsonlite::fromJSON)
}
if (missing(out_handler)) {
out_handler <- function(x) {
compile_exprs(x) %>%
purrr::map(~list(type = "command", message = .x)) %>%
purrr::map(~jsonlite::toJSON(.x, auto_unbox = TRUE))
}
}
self$app <- list(
call = function(req) { # nocov start
if (message) message("Received http request.")
list(
status = 200L,
headers = list("Content-Type" = "text/html"),
body = "Server is running."
)
},
onWSOpen = function(ws) {
self$ws <- ws
self$connected <- TRUE
ws$send(
jsonlite::toJSON(
list(type = "text",
message = "\"Connection established\""),
auto_unbox = TRUE
)
)
ws$onMessage(function(binary, input) {
in_handler(input)
})
} # nocov end
)
self$in_handler <- in_handler
self$out_handler <- out_handler
self$message <- message
self$port <- port
}
))
#' Read one or more lines from the console for the first successful parse
#'
#' @description \code{read_multilines} reads one or more lines from
#' the terminal (in interactive use).
#'
#' @inheritParams base::readline
#'
#' @details
#' This function repeatedly calls \code{readline} until enough inputs
#' are provided to reach a successful parse.
#'
#' This can only be used in an interactive session.
#'
#' @examples
#' \dontrun{
#' # In an interactive session
#' read_multilines()
#' 1 + 2 # expect immediate success
#'
#' read_multilines()
#' 1 +
#' 2 +
#' 3 # expect success here
#' }
#'
#' @export
read_multilines <- function(prompt = "") { # nocov start
success_parse <- function(x) {
is.null(purrr::safely(rlang::parse_exprs)(x)$error)
}
# Main
res <- readline(prompt = prompt)
while (!success_parse(res)) {
res <- paste(res, "\n", readline(prompt = ""))
}
return(res)
} # nocov end
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.