get a basic js example working

This commit is contained in:
Tom Elliott 2025-01-21 13:25:59 +13:00
parent 620be25588
commit 722c4de693
10 changed files with 269 additions and 9 deletions

View File

@ -41,15 +41,6 @@ ts_compile.character <- function(
x <- sapply(ls(e), \(x) ts_compile(e[[x]], file = file, name = x)) x <- sapply(ls(e), \(x) ts_compile(e[[x]], file = file, name = x))
# find any RTYPE.[type] and grab types
# types <- unique(
# gsub(
# "RTYPE\\.(\\w+)", "\\1",
# unlist(regmatches(x, gregexpr("RTYPE\\.\\w+", x)))
# )
# )
# x <- gsub("RTYPE\\.", "", x)
src <- c( src <- c(
"import { Robj } from 'rserve-ts';", "import { Robj } from 'rserve-ts';",
"import { z } from 'zod';", "import { z } from 'zod';",

71
R/deploy.R Normal file
View File

@ -0,0 +1,71 @@
#' Deploy a ts Rserve app
#'
#' @param f The path to the application files
#' @param file The file to write the deployment script to
#' @param init Names of objects (ts_functions) to make available to
#' the initialisation function
#' @param port The port to deploy the app on
#' @param run Whether to run the deployment script,
#' takes values "no", "here", "background"
#' @return NULL, called to open an Rserve instance
#' @export
#' @md
ts_deploy <- function(f,
file = sprintf("%s.rserve.R", tools::file_path_sans_ext(f)),
init = NULL,
port = 6311,
run = c("no", "here", "background")) {
if (length(f) != 1) stop("Expected a single path")
if (!file.exists(f)) stop("File not found")
x <- readLines(f)
if (is.null(init)) init <- ls_ocaps(f)
init <- sprintf(
"list(\n %s\n)",
paste(sapply(init, \(z) sprintf("%s = %s", z, z)), collapse = ",\n ")
)
src <- c(
"library(Rserve)",
"library(ts)",
"",
x,
sprintf("first.fns <- function() ts_app(%s)", init),
"",
sprintf("oc.init <- function() Rserve:::ocap(first.fns)"),
"",
sprintf(
paste(
"Rserve::run.Rserve(",
" websockets.port = %s,",
" websockets = TRUE,",
" oob = TRUE,",
" qap = FALSE,",
" websockets.qap.oc = TRUE",
")",
sep = "\n"
),
port
)
)
writeLines(src, file)
run <- match.arg(run)
switch(run,
"no" = {
cat("Run the following command to deploy the app:\n")
cat(sprintf("Rscript %s", file), "\n")
},
"here" = source(file),
"background" = system(sprintf("Rscript %s", file))
)
}
ls_ocaps <- function(f) {
e <- new.env()
source(f, local = e)
x <- ls(e)
x[sapply(x, \(z) class(e[[z]]) == "ts_function")]
}

16
man/ts_app.Rd Normal file
View File

@ -0,0 +1,16 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/function.R
\name{ts_app}
\alias{ts_app}
\title{Generate an Rserve app from a ts function}
\usage{
ts_app(x)
}
\arguments{
\item{x}{A ts function object (\code{ts_function()})}
}
\description{
Anything that is not a function simply returns itself.
However, functions are wrapped with \code{Rserve::ocap()},
and the result is subsequently wrapped with \code{ts_app()}.
}

33
man/ts_deploy.Rd Normal file
View File

@ -0,0 +1,33 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/deploy.R
\name{ts_deploy}
\alias{ts_deploy}
\title{Deploy a ts Rserve app}
\usage{
ts_deploy(
f,
file = sprintf("\%s.rserve.R", tools::file_path_sans_ext(f)),
init = NULL,
port = 6311,
run = c("no", "here", "background")
)
}
\arguments{
\item{f}{The path to the application files}
\item{file}{The file to write the deployment script to}
\item{init}{Names of objects (ts_functions) to make available to
the initialisation function}
\item{port}{The port to deploy the app on}
\item{run}{Whether to run the deployment script,
takes values "no", "here", "background"}
}
\value{
NULL, called to open an Rserve instance
}
\description{
Deploy a ts Rserve app
}

View File

@ -0,0 +1,30 @@
library(Rserve)
library(ts)
library(ts)
fn_mean <- ts_function(mean, x = ts_numeric(), result = ts_numeric(1))
fn_first <- ts_function(function(x = ts_character(-1)) x[1],
result = ts_character(1)
)
sample_num <- ts_function(
sample,
x = ts_numeric(0),
result = ts_numeric(1)
)
first.fns <- function() ts_app(list(
fn_first = fn_first,
fn_mean = fn_mean,
sample_num = sample_num
))
oc.init <- function() Rserve:::ocap(first.fns)
Rserve::run.Rserve(
websockets.port = 6311,
websockets = TRUE,
oob = TRUE,
qap = FALSE,
websockets.qap.oc = TRUE
)

1
tests/testthat/sampler/.gitignore vendored Normal file
View File

@ -0,0 +1 @@
node_modules

View File

@ -0,0 +1,25 @@
var R = require("./node_modules/rserve-ts/dist/index.js").default;
global.WebSocket = require("ws");
async function main() {
const con = await R.create({
host: "http://127.0.0.1:6311",
});
const app = await con.ocap();
console.log(app);
console.log(app.fn_mean);
app.fn_mean(new Float64Array([1, 2, 3, 4, 5]), (err, res) => {
if (err) {
console.error(err);
process.exit(1);
}
console.log("Mean:", res);
process.exit(0);
});
// console.log("Mean:", m);
}
console.log("Running sampler script...\n");
main();

View File

@ -0,0 +1,16 @@
{
"name": "sampler",
"version": "1.0.0",
"description": "",
"main": "app.js",
"scripts": {
"test": "echo \"Error: no test specified\" && exit 1",
"start": "node app.js"
},
"author": "",
"license": "ISC",
"dependencies": {
"rserve-ts": "^0.6.1",
"ws": "^8.18.0"
}
}

52
tests/testthat/sampler/pnpm-lock.yaml generated Normal file
View File

@ -0,0 +1,52 @@
lockfileVersion: '9.0'
settings:
autoInstallPeers: true
excludeLinksFromLockfile: false
importers:
.:
dependencies:
rserve-ts:
specifier: ^0.6.1
version: 0.6.1
ws:
specifier: ^8.18.0
version: 8.18.0
packages:
rserve-ts@0.6.1:
resolution: {integrity: sha512-oxT5ZttA/IExReAjZzKc80f8ug/y/xeIi2YhKSqvy9Hf7nQaQTmmtmDLfJ+vxqLuPRnhxHwjqhsjN2NpxDtLRw==}
underscore@1.13.7:
resolution: {integrity: sha512-GMXzWtsc57XAtguZgaQViUOzs0KTkk8ojr3/xAxXLITqf/3EMwxC0inyETfDFjH/Krbhuep0HNbbjI9i/q3F3g==}
ws@8.18.0:
resolution: {integrity: sha512-8VbfWfHLbbwu3+N6OKsOMpBdT4kXPDDB9cJk2bJ6mh9ucxdlnNvH1e+roYkKmN9Nxw2yjz7VzeO9oOz2zJ04Pw==}
engines: {node: '>=10.0.0'}
peerDependencies:
bufferutil: ^4.0.1
utf-8-validate: '>=5.0.2'
peerDependenciesMeta:
bufferutil:
optional: true
utf-8-validate:
optional: true
zod@3.24.1:
resolution: {integrity: sha512-muH7gBL9sI1nciMZV67X5fTKKBLtwpZ5VBp1vsOQzj1MhrBZ4wlVCm3gedKZWLp0Oyel8sIGfeiz54Su+OVT+A==}
snapshots:
rserve-ts@0.6.1:
dependencies:
underscore: 1.13.7
zod: 3.24.1
underscore@1.13.7: {}
ws@8.18.0: {}
zod@3.24.1: {}

View File

@ -0,0 +1,25 @@
test_that("Deploy converts ts functions into valid ocap lists", {
get_sample <- ts_function(
function(n = ts_numeric(1)) {
sample(values, n)
},
result = ts_numeric()
)
sampler <- ts_function(
function(values = ts_numeric()) {
list(
get = get_sample$copy(),
set = ts_function(
function(value = ts_numeric()) {
values <<- value
}
)
)
},
result = ts_list(
get = get_sample,
set = ts_function(NULL, value = ts_numeric())
)
)
})