diff --git a/NAMESPACE b/NAMESPACE index 73ee648f9..9d390ca9a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -51,6 +51,7 @@ export(nextcode) export(nextget) export(nextstream) export(on_daemon) +export(posit_workbench_config) export(register_serial) export(remote_config) export(require_daemons) diff --git a/NEWS.md b/NEWS.md index f642c56c9..0b4713ed6 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,6 +2,7 @@ #### New Features +* Adds `posit_workbench_config()` to launch remote daemons using the default Posit Workbench launcher (currently only supports Rstudio Pro sessions). * New synchronous mode: `daemons(sync = TRUE)` causes mirai to run synchronously within the current process. This facilitates testing and debugging, e.g. via interactive `browser()` instances (#439). diff --git a/R/launchers.R b/R/launchers.R index 52a7bff10..a1c0f4a1e 100644 --- a/R/launchers.R +++ b/R/launchers.R @@ -94,6 +94,12 @@ launch_remote <- function(n = 1L, remote = remote_config(), ..., .compute = NULL dots <- if (...length()) parse_dots(envir, ...) else envir[["dots"]] tls <- envir[["tls"]] + if (length(remote) == 2L) { + tools <- posit_tools() + is.environment(tools) || stop(._[["posit_api"]]) + return(posit_workbench_launch(n, remote, tools)) + } + command <- remote[["command"]] rscript <- remote[["rscript"]] quote <- remote[["quote"]] @@ -392,6 +398,35 @@ cluster_config <- function(command = "sbatch", options = "", rscript = "Rscript" list(command = "/bin/sh", args = args, rscript = rscript, quote = NULL) } +#' Posit Workbench Launch Configuration +#' +#' Generates a remote configuration for launching daemons via the default +#' launcher in Posit Workbench. Currently only supports Rstudio Pro sessions. +#' +#' @inherit remote_config return +#' +#' @seealso [ssh_config()], [cluster_config()], and [remote_config()] for other +#' types of remote launch configuration. +#' +#' @examples +#' tryCatch(posit_workbench_config(), error = identity) +#' +#' \dontrun{ +#' +#' # Launch 2 daemons using the Posit Workbench default: +#' daemons(n = 2, url = host_url(), remote = posit_workbench_config() +#' } +#' +#' @export +#' +posit_workbench_config <- function() { + tools <- posit_tools() + is.environment(tools) || stop(._[["posit_api"]]) + get_info <- .subset2(tools, ".rs.api.launcher.getInfo") + cluster <- get_info()[["clusters"]][[1L]] + list(name = cluster[["name"]], image = cluster[["defaultImage"]]) +} + #' URL Constructors #' #' `host_url()` constructs a valid host URL (at which daemons may connect) based @@ -476,3 +511,29 @@ find_dot <- function(args) { any(sel) || stop(._[["dot_required"]], call. = FALSE) sel } + +posit_tools <- function() { + idx <- match("tools:rstudio", search(), nomatch = 0L) + idx || return() + tools <- as.environment(idx) + feature_available <- .subset2(tools, ".rs.api.launcher.jobsFeatureAvailable") + is.function(feature_available) && feature_available() || return() + tools +} + +posit_workbench_launch <- function(n, remote, tools) { + submit_job <- .subset2(tools, ".rs.api.launcher.submitJob") + new_container <- .subset2(tools, ".rs.api.launcher.newContainer") + cluster <- remote[["name"]] + container <- new_container(remote[["image"]]) + cmds <- launch_remote(n) + lapply(cmds, function(cmd) + submit_job( + sprintf("mirai_daemon_%s", random(4L)), + cluster = cluster, + command = cmd, + container = container + ) + ) + cmds +} diff --git a/R/mirai-package.R b/R/mirai-package.R index e21efdc87..b61f84a1e 100644 --- a/R/mirai-package.R +++ b/R/mirai-package.R @@ -87,6 +87,7 @@ n_one = "`n` must be 1 or greater", n_zero = "the number of daemons must be zero or greater", numeric_n = "`n` must be numeric, did you mean to provide `url`?", + posit_api = "requires Posit Workbench (Rstudio Pro session)", sync_daemons = "mirai: initial sync with daemon(s) [%d secs elapsed]", sync_dispatcher = "mirai: initial sync with dispatcher [%d secs elapsed]", synchronous = "daemons cannot be launched for synchronous compute profiles", diff --git a/man/posit_workbench_config.Rd b/man/posit_workbench_config.Rd new file mode 100644 index 000000000..aa855b11a --- /dev/null +++ b/man/posit_workbench_config.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/launchers.R +\name{posit_workbench_config} +\alias{posit_workbench_config} +\title{Posit Workbench Launch Configuration} +\usage{ +posit_workbench_config() +} +\value{ +A list in the required format to be supplied to the \code{remote} argument +of \code{\link[=daemons]{daemons()}} or \code{\link[=launch_remote]{launch_remote()}}. +} +\description{ +Generates a remote configuration for launching daemons via the default +launcher in Posit Workbench. Currently only supports Rstudio Pro sessions. +} +\examples{ +tryCatch(posit_workbench_config(), error = identity) + +\dontrun{ + +# Launch 2 daemons using the Posit Workbench default: +daemons(n = 2, url = host_url(), remote = posit_workbench_config() +} + +} +\seealso{ +\code{\link[=ssh_config]{ssh_config()}}, \code{\link[=cluster_config]{cluster_config()}}, and \code{\link[=remote_config]{remote_config()}} for other +types of remote launch configuration. +} diff --git a/tests/tests.R b/tests/tests.R index 581fa1a66..b8827a769 100644 --- a/tests/tests.R +++ b/tests/tests.R @@ -60,6 +60,22 @@ for (i in 0:4) test_null(register_serial("test_klass1", serialize, unserialize)) test_null(register_serial(c("test_klass2", "test_klass3"), list(serialize, serialize), list(unserialize, unserialize))) test_equal(length(mirai:::.[["serial"]][[3L]]), 3L) +# Posit workbench launcher tests +is.null(mirai:::posit_tools()) && { + ns <- new.env(parent = emptyenv()) + `[[<-`(ns, ".rs.api.launcher.jobsFeatureAvailable", function() TRUE) + `[[<-`(ns, ".rs.api.launcher.getInfo", function() list(clusters = list(list(name = "Kubernetes", defaultImage = "1.a.b.reg.prov.com/int-r-sess:ubuntu2204-20250609")))) + `[[<-`(ns, ".rs.api.launcher.newContainer", function(image) image) + `[[<-`(ns, ".rs.api.launcher.submitJob", function(...) NULL) + attach(ns, name = "tools:rstudio") + cfg <- posit_workbench_config() + test_type("list", cfg) + test_true(daemons(url = local_url(), dispatcher = FALSE)) + test_class("miraiLaunchCmd", launch_remote(n = 2L, remote = cfg)) + test_false(daemons(0)) + detach() + test_error(posit_workbench_config(), "requires Posit Workbench") +} # mirai and daemons tests connection && { Sys.sleep(1L)