tom/ts
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge pull request #1 from tmelliott/develop

Browse Source 
Initial implementation of compile and deploy
This commit is contained in:
Tom Elliott 2025-01-22 09:10:41 +13:00 committed by GitHub
commit 3357cd8e4d
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
39 changed files with 1361 additions and 328 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.Rbuildignore
View File

@ -1,2 +1,3 @@
^LICENSE\.md$ ^LICENSE\.md$
^README\.Rmd$ ^README\.Rmd$
^Makefile$

5
DESCRIPTION
View File

@ -13,3 +13,8 @@ RoxygenNote: 7.3.1
Suggests: Suggests:
testthat (>= 3.0.0) testthat (>= 3.0.0)
Config/testthat/edition: 3 Config/testthat/edition: 3
Imports:
cli,
js,
rlang,
Rserve

3
Makefile
View File

@ -11,3 +11,6 @@ install: document
README.md: README.Rmd install README.md: README.Rmd install
Rscript -e "rmarkdown::render('README.Rmd')" Rscript -e "rmarkdown::render('README.Rmd')"
@rm README.html @rm README.html
test:
Rscript -e "devtools::test()"

17
NAMESPACE
View File

@ -1,15 +1,32 @@
# Generated by roxygen2: do not edit by hand # Generated by roxygen2: do not edit by hand
S3method(check_type,default)
S3method(check_type,ts_function)
S3method(check_type,ts_object)
S3method(get_type,default)
S3method(get_type,ts_function)
S3method(get_type,ts_object)
S3method(print,ts_function)
S3method(print,ts_object) S3method(print,ts_object)
S3method(ts_app,default)
S3method(ts_app,list)
S3method(ts_app,ts_function)
S3method(ts_compile,character) S3method(ts_compile,character)
S3method(ts_compile,default) S3method(ts_compile,default)
S3method(ts_compile,ts_function) S3method(ts_compile,ts_function)
export(check_type)
export(get_type)
export(is_ts_object)
export(ts_app)
export(ts_character) export(ts_character)
export(ts_compile) export(ts_compile)
export(ts_dataframe) export(ts_dataframe)
export(ts_deploy)
export(ts_factor) export(ts_factor)
export(ts_function) export(ts_function)
export(ts_integer) export(ts_integer)
export(ts_list) export(ts_list)
export(ts_logical) export(ts_logical)
export(ts_null)
export(ts_numeric) export(ts_numeric)
export(ts_void)

62
R/compile.R
View File

@ -1,30 +1,33 @@
#' Compile R functions to TypeScript schemas
#' @param f A function or file path
#' @param name The name of the function
#' @param ... Additional arguments
#' @param file The file path to write the TypeScript schema (optional). If `""`, the output is printed to the standard output console (see `cat`).
#' @return Character vector of TypeScript schema, or NULL if writing to file
#' @md
#' @export #' @export
ts_compile <- function(f, ..., file = NULL) { ts_compile <- function(f, ..., name, file) {
o <- UseMethod("ts_compile") o <- UseMethod("ts_compile")
} }
#' @export #' @export
ts_compile.ts_function <- function(f, name = deparse(substitute(f)), ...) { ts_compile.ts_function <- function(f, ..., name = deparse(substitute(f))) {
inputs <- attr(f, "args") inputs <- f$args
result <- attr(f, "result") result <- f$result
inputs <- sapply(inputs, \(x) x$type) inputs <- sapply(inputs, \(x) x$input_type)
fn_args <- paste(inputs) |> fn_args <- paste(paste(inputs), collapse = ", ")
paste(collapse = ", ")
sprintf("const %s = R.ocap([%s], %s]);", name, fn_args, result$type_fn) sprintf(
"const %s = Robj.ocap([%s], %s);", name, fn_args,
result$return_type
)
} }
# #' @export
# ts_compile.ts_overload <- function(f, file = NULL, name = deparse(substitute(f))) {
# cmt <- sprintf("\n// %s overloads", name)
# oloads <- sapply(f, ts_compile, name = name)
# paste(cmt, paste(oloads, collapse = "\n"), sep = "\n")
# }
#' @export #' @export
ts_compile.character <- function( ts_compile.character <- function(
f, f,
file = sprintf("%s.d.ts", tools::file_path_sans_ext(f))) { file = sprintf("%s.rserve.ts", tools::file_path_sans_ext(f))) {
if (length(f) > 1) { if (length(f) > 1) {
return(sapply(f, ts_compile)) return(sapply(f, ts_compile))
} }
@ -38,23 +41,20 @@ 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 src <- c(
types <- unique( "import { Robj } from 'rserve-ts';",
gsub( "import { z } from 'zod';",
"RTYPE\\.(\\w+)", "\\1", "\n",
unlist(regmatches(x, gregexpr("RTYPE\\.\\w+", x))) x,
) "\n",
sprintf("export default {\n %s\n};", paste(ls(e), collapse = ",\n "))
) )
x <- gsub("RTYPE\\.", "", x)
cat( # if (file != "" && file.exists(file)) {
sprintf( # stop(sprintf("File exists: %s", file))
"import { %s } from 'rserve-ts';\n\n", # return()
paste(types, collapse = ", ") # }
), cat(src, file = file, sep = "\n")
file = file
)
cat(x, sep = "\n", file = file, append = TRUE)
invisible() invisible()
} }

73
R/deploy.R Normal file
View File

@ -0,0 +1,73 @@
#' 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 ")
)
x <- x[!grepl("library\\(ts\\)", x)] # Remove library(ts) from the app
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")]
}

131
R/function.R
View File

@ -1,6 +1,5 @@
parse_args <- function(x, mc) { parse_args <- function(x, mc) {
fmls <- lapply(x, eval) fmls <- lapply(x, eval)
mc <- mc[-1]
if (!all(names(mc) %in% names(fmls))) { if (!all(names(mc) %in% names(fmls))) {
stop( stop(
"Invalid argument(s): ", "Invalid argument(s): ",
@ -8,54 +7,118 @@ parse_args <- function(x, mc) {
) )
} }
args <- lapply(names(fmls), function(n) { args <- lapply(names(fmls), function(n) {
fmls[[n]]$check(eval(mc[[n]])) tryCatch(
{
fmls[[n]]$check(eval(mc[[n]]))
},
error = function(e) {
stop("Invalid argument '", n, "': ", e$message, call. = FALSE)
}
)
}) })
names(args) <- names(fmls) names(args) <- names(fmls)
args args
} }
check_args <- function(args, fmls) {
args <- as.list(args)[-1]
fmls <- lapply(fmls, eval)
lapply(names(fmls), function(n) {
tryCatch(
{
fmls[[n]]$check(args[[n]])
},
error = function(e) {
stop("Invalid argument '", n, "': ", e$message, call. = FALSE)
}
)
})
}
ts_result <- function(type, value) {
if (type$check(value)) {
return(value)
}
stop("Expected a value of type ", type$type)
}
#' TS function definition #' TS function definition
#' #'
#' @param f an R function #' @param f an R function
#' @param ... argument definitions, OR function overloads #' @param ... argument definitions (only required if f does not specify these in its formals)
#' @param result return type (ignored if overloads are provided) #' @param result return type (ignored if overloads are provided)
#' @export #' @export
ts_function <- function(f, ..., result = NULL) { ts_function <- function(f, ..., result = ts_void()) {
args <- list(...) args <- list(...)
if (!is.null(result) && !is_object(result)) { if (!is.null(result) && !is_ts_object(result)) {
stop("Invalid return type") stop("Invalid return type")
} }
# TODO: implement overloads, if possible with zod
# if (any(is_overload(args))) {
# if (!all(is_overload(args))) {
# stop("Cannot mix overloads with standard arguments")
# }
# z <- lapply(args, function(x) {
# do.call(ts_function, c(list(f), x$args, list(result = x$result)))
# })
# class(z) <- "ts_overload"
# return(z)
# }
fn <- function(...) { if (length(args) == 0) {
mc <- match.call(f) args <- lapply(formals(f), eval)
x <- parse_args(args, mc)
result$check(do.call(f, x))
} }
attr(fn, "args") <- args
attr(fn, "result") <- result e <- new.env()
class(fn) <- c("ts_function", class(f)) e$f <- f
fn # e$env <- env
e$args <- args
e$result <- result
e$call <- function(...) {
mc <- match.call(e$f)
.args <- parse_args(args, mc[-1])
.res <- do.call(e$f, .args)
check_type(result, .res)
}
e$copy <- function(env = parent.frame()) {
e2 <- e
environment(e2$f) <- rlang::env_clone(environment(e$f), env)
e2
}
class(e) <- "ts_function"
e
} }
# #' @export
# is_overload <- function(x) {
# sapply(x, inherits, what = "ts_overload")
# }
# #' @export
# ts_overload <- function(..., result = NULL) { #' @export
# structure(list(args = list(...), result = result), print.ts_function <- function(x, ...) {
# class = "ts_overload" cli::cli_h3("Ocap function")
# )
# } cli::cli_text("Arguments:")
args <- lapply(x$args, \(z) z$input_type)
lapply(names(args), \(n) {
cat("- ", n, ": ", args[[n]], "\n", sep = "")
})
cli::cli_text("\n\n")
cli::cli_text("Return type:")
cat(x$result$return_type)
}
#' Generate an Rserve app from a ts function
#'
#' Anything that is not a function simply returns itself.
#' However, functions are wrapped with `Rserve::ocap()`,
#' and the result is subsequently wrapped with `ts_app()`.
#' @param x A ts function object (`ts_function()`)
#' @export
#' @md
ts_app <- function(x) UseMethod("ts_app")
#' @export
ts_app.default <- function(x) {
x
}
#' @export
ts_app.list <- function(x) {
lapply(x, ts_app)
}
#' @export
ts_app.ts_function <- function(x) {
Rserve::ocap(function(...) ts_app(x$call(...)))
}

291
R/types.R
View File

@ -2,18 +2,18 @@
#' #'
#' This is the base type for all typed objects. It is not meant to be used directly. #' This is the base type for all typed objects. It is not meant to be used directly.
#' #'
#' @param type The type of the object that Typescript expect to send to R. #' @param input_type The type of the object that Typescript expect to send to R.
#' @param type_fn The type of the object that Typescript expects to recieve from R. #' @param return_type The type of the object that Typescript expects to recieve from R.
#' @param default The default value of the object. #' @param default The default value of the object.
#' @param check A function that checks the object and returns it if it is valid. This operates on the R side and is mostly for development and debugging purposes. It is up to the developer to ensure that all functions return the correct type of object always. #' @param check A function that checks the object and returns it if it is valid. This operates on the R side and is mostly for development and debugging purposes. It is up to the developer to ensure that all functions return the correct type of object always.
#' @param generic logical, if `TRUE` then the object is a generic type. #' @param generic logical, if `TRUE` then the object is a generic type.
#' #'
#' @md #' @md
object <- function(type = "any", ts_object <- function(input_type = "any",
type_fn = "any", return_type = "any",
default = NULL, default = NULL,
check = function() stop("Not implemented"), check = function() stop("Not implemented"),
generic = FALSE) { generic = FALSE) {
e <- environment() e <- environment()
e$attr <- function(name, value) { e$attr <- function(name, value) {
@ -27,23 +27,100 @@ object <- function(type = "any",
#' @export #' @export
print.ts_object <- function(x, ...) { print.ts_object <- function(x, ...) {
# name <- deparse(substitute(x)) # name <- deparse(substitute(x))
cat(sprintf("Input (ts) type: %s\n", x$type)) cli::cli_ul()
cat(sprintf("Output (R) type: %s\n", x$type_fn)) cli::cli_h3("Input type: ")
if (nchar(x$input_type) > 50) {
cat(js::uglify_reformat(x$input_type, beautify = TRUE), "\n")
} else {
cat(x$input_type, "\n")
}
cli::cli_h3("Return type: ")
if (nchar(x$return_type) > 50) {
print(x$return_type)
cat(js::uglify_reformat(x$return_type, beautify = TRUE), "\n")
} else {
cat(x$return_type, "\n")
}
cli::cli_end()
} }
is_object <- function(x) { #' @describeIn ts_object Check if an object is a ts object
#' @export
is_ts_object <- function(x) {
inherits(x, "ts_object") inherits(x, "ts_object")
} }
ts_union <- function(...) paste(..., sep = " | ") #' @describeIn ts_object Get the input type of a ts object
ts_array <- function(type = c("number", "boolean", "string")) { #' @param x A ts object
if (type == "number") { #' @param which Which type to get, either "input" or "return"
return("Float64Array") #' @export
get_type <- function(x, which = c("input", "return")) {
UseMethod("get_type")
}
#' @export
get_type.ts_object <- function(x, which = c("input", "return")) {
which <- match.arg(which)
if (which == "input") {
return(x$input_type)
} }
if (type == "boolean") { x$return_type
return("Uint8Array") }
#' @export
get_type.ts_function <- function(x, which = c("input", "return")) {
which <- match.arg(which)
if (which == "input") {
return("z.function()")
} }
return("RTYPE.stringArray") "Robj.ocap()"
}
#' @export
get_type.default <- function(x, which) {
stop("Invalid object")
}
#' @describeIn ts_object Check if an object has the correct type
#' @param type A ts object
#' @param x An object
#' @export
check_type <- function(type, x) UseMethod("check_type")
#' @export
check_type.default <- function(type, x) {
stop("Invalid object")
}
#' @export
check_type.ts_object <- function(type, x) {
type$check(x)
}
#' @export
check_type.ts_function <- function(type, x) {
if ("ts_function" %in% class(x)) {
return(x)
}
if (!is.function(x)) stop("Expected a function")
do.call(
ts_function,
c(
list(x), attr(type, "args"),
list(result = attr(type, "result"))
)
)
}
ts_union <- function(...) sprintf("z.union([%s])", paste(..., sep = ", "))
ts_array <- function(type = c("z.number()", "z.boolean()", "z.string()")) {
if (type == "z.number()") {
return("z.instanceof(Float64Array)")
}
if (type == "z.boolean()") {
return("z.instanceof(Uint8Array)")
}
return("z.array(z.string())")
} }
n_type <- function(n, type, pl = ts_array(type)) { n_type <- function(n, type, pl = ts_array(type)) {
@ -56,43 +133,72 @@ n_type <- function(n, type, pl = ts_array(type)) {
pl pl
} }
n_type_fun <- function(n, type) { n_type_fun <- function(n, type) {
if (n < 0) { sprintf("%s(%s)", type, ifelse(n < 0, "", n))
return(type)
}
sprintf("%s(%s)", type, n)
} }
#' Logical or boolean type
#'
#' Booleans are represented in Zod schema as either a boolean (`z.boolean()`),
#' or a typed Uint8Array (`z.instanceof(Uint8Array)`).
#'
#' @param n The length of the boolean vector. If `n = 1` then a single boolean is expected. If `n = 0` then any length is expected. If `n > 1` then a boolean vector of length `n` is expected.
#' @return A ts object that accepts logical scalars or vectors of length `n`.
#' @export #' @export
#' @md
ts_logical <- function(n = -1L) { ts_logical <- function(n = -1L) {
object( ts_object(
n_type(n, "boolean"), n_type(n, "z.boolean()"),
n_type_fun(n, "RTYPE.logical"), n_type_fun(n, "Robj.logical"),
check = function(x) { check = function(x) {
if (!is.logical(x)) stop("Expected a boolean") if (!is.logical(x)) stop("Expected a boolean")
if (n > 0 && length(x) != n) stop("Expected a boolean of length ", n) if (n > 0 && length(x) != n) {
stop("Expected a boolean of length ", n)
}
x x
} }
) )
} }
#' Integer type
#'
#' Integers are represented in Zod schema as either a number (`z.number()`),
#' or a Int32Array (`z.instanceof(Int32Array)`).
#'
#' @param n The length of the integer vector. If `n = 1` then a single integer is expected. If `n = 0` then any length is expected. If `n > 1` then an integer vector of length `n` is expected.
#' @return A ts object that accepts integer scalars or vectors of length `n`.
#' @export #' @export
#' @md
ts_integer <- function(n = -1L) { ts_integer <- function(n = -1L) {
object( ts_object(
n_type(n, "number"), n_type(n, "z.number()", "z.instanceof(Int32Array)"),
n_type_fun(n, "RTYPE.integer"), n_type_fun(n, "Robj.integer"),
check = function(x) { check = function(x) {
if (!is.integer(x)) stop("Expected an integer") if (!is.numeric(x)) stop("Expected a number")
if (n > 0 && length(x) != n) stop("Expected an integer of length ", n) if (!all.equal(x, as.integer(x))) {
# javascript only has one number type
stop("Expected an integer")
}
if (n > 0 && length(x) != n) {
stop("Expected an integer of length ", n)
}
x x
} }
) )
} }
#' Numeric type
#'
#' Numbers are represented in Zod schema as either a number (`z.number()`),
#' or a Float64Array (`z.instanceof(Float64Array)`).
#'
#' @param n The length of the numeric vector. If `n = 1` then a single number is expected. If `n = 0` then any length is expected. If `n > 1` then a numeric vector of length `n` is expected.
#' @return A ts object that accepts numeric scalars or vectors of length `n`.
#' @export #' @export
#' @md
ts_numeric <- function(n = -1L) { ts_numeric <- function(n = -1L) {
object( ts_object(
n_type(n, "number"), n_type(n, "z.number()"),
n_type_fun(n, "RTYPE.numeric"), n_type_fun(n, "Robj.numeric"),
check = function(x) { check = function(x) {
if (!is.numeric(x)) stop("Expected a number", call. = FALSE) if (!is.numeric(x)) stop("Expected a number", call. = FALSE)
if (n > 0 && length(x) != n) { if (n > 0 && length(x) != n) {
@ -103,11 +209,18 @@ ts_numeric <- function(n = -1L) {
) )
} }
#' Character or string type
#'
#' Strings are represented in Zod schema as either a string (`z.string()`),
#' or a string array (`z.array(z.string())`).
#' @param n The length of the string vector. If `n = 1` then a single string is expected. If `n = 0` then any length is expected. If `n > 1` then a string vector of length `n` is expected.
#' @return A ts object that accepts strings or string vectors of length `n`.
#' @export #' @export
#' @md
ts_character <- function(n = -1L) { ts_character <- function(n = -1L) {
object( ts_object(
n_type(n, "string"), n_type(n, "z.string()"),
n_type_fun(n, "RTYPE.character"), n_type_fun(n, "Robj.character"),
check = function(x) { check = function(x) {
if (!is.character(x)) stop("Expected a string") if (!is.character(x)) stop("Expected a string")
if (n > 0 && length(x) != n) stop("Expected a string of length ", n) if (n > 0 && length(x) != n) stop("Expected a string of length ", n)
@ -125,21 +238,28 @@ vector_as_ts_array <- function(x) {
#' Factors are integers with labels. On the JS side, these are *always* represented as a string array (even if only one value - yay!). #' Factors are integers with labels. On the JS side, these are *always* represented as a string array (even if only one value - yay!).
#' #'
#' @param levels A character vector of levels (optional). #' @param levels A character vector of levels (optional).
#' @return A ts object that accepts factors with the specified levels.
#' #'
#' @export #' @export
#' @md #' @md
ts_factor <- function(levels = NULL) { ts_factor <- function(levels = NULL) {
object( ts_object(
sprintf("(%s)[]", paste(levels, collapse = " | ")), ifelse(is.null(levels),
ts_array("z.string()"),
sprintf("(%s)[]", paste(levels, collapse = " | "))
),
if (is.null(levels)) { if (is.null(levels)) {
"Factor" "Robj.factor()"
} else { } else {
sprintf("Factor<%s>", vector_as_ts_array(levels)) sprintf("Robj.factor(%s)", vector_as_ts_array(levels))
}, },
check = function(x) { check = function(x) {
if (!is.factor(x)) stop("Expected a factor") if (!is.factor(x)) stop("Expected a factor")
if (!is.null(levels) && !identical(levels, levels(x))) { if (!is.null(levels) && !identical(levels, levels(x))) {
stop("Expected a factor with levels ", levels) stop(
"Expected a factor with levels: ",
paste(levels, collapse = ", ")
)
} }
x x
} }
@ -151,35 +271,54 @@ ts_factor <- function(levels = NULL) {
#' Typed list #' Typed list
#' #'
#' A list is a vector of other robjects, which may or may not be named. #' A list is a vector of other robjects, which may or may not be named.
#' @param ... A list of types, named or unnamed.
#' @return A ts object that accepts lists with the specified types.
#' #'
#' @export #' @export
#' @md #' @md
ts_list <- function(values = NULL) { ts_list <- function(...) {
type <- "[]" values <- list(...)
type <- "z.union([z.object({}), z.array(z.any())])"
type_fn <- "" type_fn <- ""
if (!is.null(values)) { if (length(values)) {
types <- sapply(values, function(x) x$type) types <- sapply(values, get_type, which = "input")
type_funs <- sapply(values, function(x) x$type_fn) type_funs <- sapply(values, get_type, which = "return")
if (!is.null(names(values))) { if (!is.null(names(values))) {
type <- sprintf( type <- sprintf(
"{%s}", "{ %s }",
paste(names(values), types, sep = ": ", collapse = ", ") paste(names(values), types, sep = ": ", collapse = ", ")
) )
type_fn <- sprintf( type_fn <- sprintf(
"{%s}", "{ %s }",
paste(names(values), type_funs, sep = ": ", collapse = ", ") paste(names(values), type_funs, sep = ": ", collapse = ", ")
) )
} else { } else {
type <- sprintf("[%s]", paste(values, collapse = ", ")) type <- sprintf("[%s]", paste(types, collapse = ", "))
type_fn <- sprintf("[%s]", paste(type_funs, collapse = ", ")) type_fn <- sprintf("[%s]", paste(type_funs, collapse = ", "))
} }
} }
object( ts_object(
type, type,
sprintf("List<%s>", type_fn), ifelse(type_fn == "", "Robj.list()",
sprintf("Robj.list(%s)", type_fn)
),
check = function(x) { check = function(x) {
if (!is.list(x)) stop("Expected a list") if (!is.list(x)) stop("Expected a list")
if (!is.null(values)) {
if (!is.null(names(values))) {
if (!identical(names(x), names(values))) {
stop(
"Expected a list with names: ",
paste(names(values), collapse = ", ")
)
}
}
for (i in seq_along(values)) {
x[[i]] <- check_type(values[[i]], x[[i]])
}
}
x x
} }
) )
@ -190,19 +329,22 @@ ts_list <- function(values = NULL) {
#' #'
#' This is essentially a list, but the elements must have names and are all the same length. #' This is essentially a list, but the elements must have names and are all the same length.
#' #'
#' @param ... Named types.
#' @return A ts object that accepts data frames with the specified types.
#'
#' @export #' @export
#' @md #' @md
ts_dataframe <- function(...) { ts_dataframe <- function(...) {
values <- list(...) values <- list(...)
type <- "{}" type <- "z.record(z.string(), z.any())"
type_fn <- "" type_fn <- ""
if (length(values)) { if (length(values)) {
types <- sapply(values, function(x) x$type) types <- sapply(values, get_type, which = "input")
type_funs <- sapply(values, function(x) x$type_fn) type_funs <- sapply(values, get_type, which = "return")
if (is.null(names(values))) stop("Expected named elements") if (is.null(names(values))) stop("Expected named elements")
type <- sprintf( type <- sprintf(
"{\n %s\n}", "z.object({\n %s\n})",
paste(names(values), types, sep = ": ", collapse = ",\n ") paste(names(values), types, sep = ": ", collapse = ",\n ")
) )
type_fn <- sprintf( type_fn <- sprintf(
@ -211,12 +353,47 @@ ts_dataframe <- function(...) {
) )
} }
object( ts_object(
type, type,
sprintf("List<%s>", type), sprintf("R.dataframe(%s)", type_fn),
check = function(x) { check = function(x) {
if (!is.data.frame(x)) stop("Expected a data frame") if (!is.data.frame(x)) stop("Expected a data frame")
x x
} }
) )
} }
#' Null type
#'
#' This is a type that only accepts `NULL`.
#'
#' @return A ts object that only accepts `NULL`.
#' @export
#'
ts_null <- function() {
ts_object(
"z.null()",
"Robj.null()",
check = function(x) {
if (!is.null(x)) stop("Expected NULL")
x
}
)
}
#' Void type
#'
#' This is a type that accepts null values (this would typically be used for
#' functions that return nothing).
#' @return A ts object that accepts `NULL`.
#' @export
#' @md
ts_void <- function() {
ts_object(
"z.void()",
"null",
check = function(x) {
return(NULL)
}
)
}

115
README.Rmd
View File

@ -33,86 +33,63 @@ devtools::install_github("tmelliott/ts")
Writing functions is easy, just use the `ts_*()` functions to define formals and return types. Writing functions is easy, just use the `ts_*()` functions to define formals and return types.
```r ```r
# demo.R
library(ts) library(ts)
app <- ts_app( addFn <- ts_function(
add = ts_fun( function(a = ts_numeric(1), b = ts_numeric(1)) a + b,
function(x, y) { result = ts_numeric(1)
x + y )
}, sampleFn <- ts_function(
x = ts_number(), function(x = ts_character(), n = ts_integer(1)) sample(x, n),
y = ts_number(), result = ts_character()
# ideally this will use a generic type where x OR y can be vectors )
# and, if one is a vector, the return type will be a vector too... app <- ts_function(
result = ts_number() function() {
), list(
sample = ts_fun( add = addFn,
function(x, n) { sample = sampleFn
sample(x, n)
},
x = ts_character_vector(),
n = ts_integer(),
result = ts_condition(n,
1 = ts_character(),
ts_character_vector()
) )
},
result = ts_list(
add = addFn,
sample = sampleFn
) )
) )
ts_compile(app) # TODO: specify exactly which functions to export in the entry point
# ts_export(app)
``` ```
This will generate the following rserve-ts function definitions: Then use `ts_compile()` to generate the TypeScript schemas:
```typescript ```typescript
import { types as R } from "rserve-ts"; import { Robj } from 'rserve-ts';
import { z } from 'zod';
export const app = { const addFn = Robj.ocap([z.number(), z.number()], Robj.numeric(1));
add: z.function( const app = Robj.ocap([],
z.tuple([z.number(), z.number()]), Robj.list({
z.promise(R.numeric(1)) add: Robj.ocap(),
), sample: Robj.ocap()
sample: z.function( })
z.tuple([z.character_vector(), z.integer()]), );
z.promise(R.character()) const sampleFn = Robj.ocap(
) [z.union([z.string(), z.array(z.string())]), z.number()],
Robj.character()
);
export default {
addFn,
app,
sampleFn
}; };
``` ```
which will generate the following types: You can then import this into your [rserve-ts](https://www.npmjs.com/package/rserve-ts) application. See `tests/testthat/sampler` for an example.
```typescript
type App = { It is also possible to generate a sourceable file to deploy an Rserve instance with your app code using `ts_deploy()`:
add: (x: number, y: number) => Promise<{ data: number }>;
sample: (x: string[], n: number) => Promise<{ data: string | string[] }>; ```r
// or, if possible, even better: ts_deploy(app)
sample: <N extends number>(x: string[], n: N) => # run with: Rscript app.rserve.R
Promise<{ data: N extends 1 ? string : string[] }>;
};
``` ```
## State of the project
Here's what's currently working:
```{r, error = TRUE}
library(ts)
myfun <- ts_function(mean, x = ts_numeric(), result = ts_numeric(1))
myfun(1:5)
myfun("hello world")
cat(readLines("tests/testthat/app.R"), sep = "\n")
ts_compile("tests/testthat/app.R", file = "")
```
## TODO
- [ ] Add support for more types
- [ ] Allow generic types (e.g., `<T>(x: T) => T`)
- [ ] Add support for conditional return types
e.g., `const sample = <T, N extends number>(x: T[], n: N) => N extends 1 ? T : T[]`
- [ ] Function overloads? Perhaps just a wrapper around several function definitions...

131
README.md
View File

@ -27,105 +27,66 @@ Writing functions is easy, just use the `ts_*()` functions to define
formals and return types. formals and return types.
``` r ``` r
# demo.R
library(ts) library(ts)
app <- ts_app( addFn <- ts_function(
add = ts_fun( function(a = ts_numeric(1), b = ts_numeric(1)) a + b,
function(x, y) { result = ts_numeric(1)
x + y )
}, sampleFn <- ts_function(
x = ts_number(), function(x = ts_character(), n = ts_integer(1)) sample(x, n),
y = ts_number(), result = ts_character()
# ideally this will use a generic type where x OR y can be vectors )
# and, if one is a vector, the return type will be a vector too... app <- ts_function(
result = ts_number() function() {
), list(
sample = ts_fun( add = addFn,
function(x, n) { sample = sampleFn
sample(x, n)
},
x = ts_character_vector(),
n = ts_integer(),
result = ts_condition(n,
1 = ts_character(),
ts_character_vector()
) )
},
result = ts_list(
add = addFn,
sample = sampleFn
) )
) )
ts_compile(app) # TODO: specify exactly which functions to export in the entry point
# ts_export(app)
``` ```
This will generate the following rserve-ts function definitions: Then use `ts_compile()` to generate the TypeScript schemas:
``` typescript ``` typescript
import { types as R } from "rserve-ts"; import { Robj } from 'rserve-ts';
import { z } from 'zod';
export const app = { const addFn = Robj.ocap([z.number(), z.number()], Robj.numeric(1));
add: z.function( const app = Robj.ocap([],
z.tuple([z.number(), z.number()]), Robj.list({
z.promise(R.numeric(1)) add: Robj.ocap(),
), sample: Robj.ocap()
sample: z.function( })
z.tuple([z.character_vector(), z.integer()]), );
z.promise(R.character()) const sampleFn = Robj.ocap(
) [z.union([z.string(), z.array(z.string())]), z.number()],
Robj.character()
);
export default {
addFn,
app,
sampleFn
}; };
``` ```
which will generate the following types: You can then import this into your
[rserve-ts](https://www.npmjs.com/package/rserve-ts) application. See
`tests/testthat/sampler` for an example.
``` typescript It is also possible to generate a sourceable file to deploy an Rserve
type App = { instance with your app code using `ts_deploy()`:
add: (x: number, y: number) => Promise<{ data: number }>;
sample: (x: string[], n: number) => Promise<{ data: string | string[] }>;
// or, if possible, even better:
sample: <N extends number>(x: string[], n: N) =>
Promise<{ data: N extends 1 ? string : string[] }>;
};
```
## State of the project
Here’s what’s currently working:
``` r ``` r
library(ts) ts_deploy(app)
# run with: Rscript app.rserve.R
myfun <- ts_function(mean, x = ts_numeric(), result = ts_numeric(1))
myfun(1:5)
#> [1] 3
myfun("hello world")
#> Error: Expected a number
cat(readLines("tests/testthat/app.R"), sep = "\n")
#> library(ts)
#>
#> fn_mean <- ts_function(mean, x = ts_numeric(), result = ts_numeric(1))
#> fn_first <- ts_function(function(x) x[1],
#> x = ts_character(-1), result = ts_character(1)
#> )
#>
#> sample_num <- ts_function(
#> sample,
#> x = ts_numeric(0),
#> result = ts_numeric(1)
#> )
ts_compile("tests/testthat/app.R", file = "")
#> Error in ts_compile.ts_function(e[[x]], file = file, name = x): unused argument (file = file)
``` ```
## TODO
- [ ] Add support for more types
- [ ] Allow generic types (e.g., `<T>(x: T) => T`)
- [ ] Add support for conditional return types
e.g., `const sample = <T, N extends number>(x: T[], n: N) => N
extends 1 ? T : T[]`
- [ ] Function overloads? Perhaps just a wrapper around several
function definitions…

28
man/object.Rd
View File

@ -1,28 +0,0 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/types.R
\name{object}
\alias{object}
\title{Typed object}
\usage{
object(
type = "any",
type_fn = "any",
default = NULL,
check = function() stop("Not implemented"),
generic = FALSE
)
}
\arguments{
\item{type}{The type of the object that Typescript expect to send to R.}
\item{type_fn}{The type of the object that Typescript expects to recieve from R.}
\item{default}{The default value of the object.}
\item{check}{A function that checks the object and returns it if it is valid. This operates on the R side and is mostly for development and debugging purposes. It is up to the developer to ensure that all functions return the correct type of object always.}
\item{generic}{logical, if \code{TRUE} then the object is a generic type.}
}
\description{
This is the base type for all typed objects. It is not meant to be used directly.
}

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()}.
}

18
man/ts_character.Rd Normal file
View File

@ -0,0 +1,18 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/types.R
\name{ts_character}
\alias{ts_character}
\title{Character or string type}
\usage{
ts_character(n = -1L)
}
\arguments{
\item{n}{The length of the string vector. If \code{n = 1} then a single string is expected. If \code{n = 0} then any length is expected. If \code{n > 1} then a string vector of length \code{n} is expected.}
}
\value{
A ts object that accepts strings or string vectors of length \code{n}.
}
\description{
Strings are represented in Zod schema as either a string (\code{z.string()}),
or a string array (\code{z.array(z.string())}).
}

23
man/ts_compile.Rd Normal file
View File

@ -0,0 +1,23 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/compile.R
\name{ts_compile}
\alias{ts_compile}
\title{Compile R functions to TypeScript schemas}
\usage{
ts_compile(f, ..., name, file)
}
\arguments{
\item{f}{A function or file path}
\item{...}{Additional arguments}
\item{name}{The name of the function}
\item{file}{The file path to write the TypeScript schema (optional). If \code{""}, the output is printed to the standard output console (see \code{cat}).}
}
\value{
Character vector of TypeScript schema, or NULL if writing to file
}
\description{
Compile R functions to TypeScript schemas
}

6
man/ts_dataframe.Rd
View File

@ -6,6 +6,12 @@
\usage{ \usage{
ts_dataframe(...) ts_dataframe(...)
} }
\arguments{
\item{...}{Named types.}
}
\value{
A ts object that accepts data frames with the specified types.
}
\description{ \description{
This is essentially a list, but the elements must have names and are all the same length. This is essentially a list, but the elements must have names and are all the same length.
} }

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
}

3
man/ts_factor.Rd
View File

@ -9,6 +9,9 @@ ts_factor(levels = NULL)
\arguments{ \arguments{
\item{levels}{A character vector of levels (optional).} \item{levels}{A character vector of levels (optional).}
} }
\value{
A ts object that accepts factors with the specified levels.
}
\description{ \description{
Factors are integers with labels. On the JS side, these are \emph{always} represented as a string array (even if only one value - yay!). Factors are integers with labels. On the JS side, these are \emph{always} represented as a string array (even if only one value - yay!).
} }

4
man/ts_function.Rd
View File

@ -4,12 +4,12 @@
\alias{ts_function} \alias{ts_function}
\title{TS function definition} \title{TS function definition}
\usage{ \usage{
ts_function(f, ..., result = NULL) ts_function(f, ..., result = ts_void())
} }
\arguments{ \arguments{
\item{f}{an R function} \item{f}{an R function}
\item{...}{argument definitions, OR function overloads} \item{...}{argument definitions (only required if f does not specify these in its formals)}
\item{result}{return type (ignored if overloads are provided)} \item{result}{return type (ignored if overloads are provided)}
} }

18
man/ts_integer.Rd Normal file
View File

@ -0,0 +1,18 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/types.R
\name{ts_integer}
\alias{ts_integer}
\title{Integer type}
\usage{
ts_integer(n = -1L)
}
\arguments{
\item{n}{The length of the integer vector. If \code{n = 1} then a single integer is expected. If \code{n = 0} then any length is expected. If \code{n > 1} then an integer vector of length \code{n} is expected.}
}
\value{
A ts object that accepts integer scalars or vectors of length \code{n}.
}
\description{
Integers are represented in Zod schema as either a number (\code{z.number()}),
or a Int32Array (\code{z.instanceof(Int32Array)}).
}

8
man/ts_list.Rd
View File

@ -4,7 +4,13 @@
\alias{ts_list} \alias{ts_list}
\title{Typed list} \title{Typed list}
\usage{ \usage{
ts_list(values = NULL) ts_list(...)
}
\arguments{
\item{...}{A list of types, named or unnamed.}
}
\value{
A ts object that accepts lists with the specified types.
} }
\description{ \description{
A list is a vector of other robjects, which may or may not be named. A list is a vector of other robjects, which may or may not be named.

18
man/ts_logical.Rd Normal file
View File

@ -0,0 +1,18 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/types.R
\name{ts_logical}
\alias{ts_logical}
\title{Logical or boolean type}
\usage{
ts_logical(n = -1L)
}
\arguments{
\item{n}{The length of the boolean vector. If \code{n = 1} then a single boolean is expected. If \code{n = 0} then any length is expected. If \code{n > 1} then a boolean vector of length \code{n} is expected.}
}
\value{
A ts object that accepts logical scalars or vectors of length \code{n}.
}
\description{
Booleans are represented in Zod schema as either a boolean (\code{z.boolean()}),
or a typed Uint8Array (\code{z.instanceof(Uint8Array)}).
}

14
man/ts_null.Rd Normal file
View File

@ -0,0 +1,14 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/types.R
\name{ts_null}
\alias{ts_null}
\title{Null type}
\usage{
ts_null()
}
\value{
A ts object that only accepts \code{NULL}.
}
\description{
This is a type that only accepts \code{NULL}.
}

18
man/ts_numeric.Rd Normal file
View File

@ -0,0 +1,18 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/types.R
\name{ts_numeric}
\alias{ts_numeric}
\title{Numeric type}
\usage{
ts_numeric(n = -1L)
}
\arguments{
\item{n}{The length of the numeric vector. If \code{n = 1} then a single number is expected. If \code{n = 0} then any length is expected. If \code{n > 1} then a numeric vector of length \code{n} is expected.}
}
\value{
A ts object that accepts numeric scalars or vectors of length \code{n}.
}
\description{
Numbers are represented in Zod schema as either a number (\code{z.number()}),
or a Float64Array (\code{z.instanceof(Float64Array)}).
}

52
man/ts_object.Rd Normal file
View File

@ -0,0 +1,52 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/types.R
\name{ts_object}
\alias{ts_object}
\alias{is_ts_object}
\alias{get_type}
\alias{check_type}
\title{Typed object}
\usage{
ts_object(
input_type = "any",
return_type = "any",
default = NULL,
check = function() stop("Not implemented"),
generic = FALSE
)
is_ts_object(x)
get_type(x, which = c("input", "return"))
check_type(type, x)
}
\arguments{
\item{input_type}{The type of the object that Typescript expect to send to R.}
\item{return_type}{The type of the object that Typescript expects to recieve from R.}
\item{default}{The default value of the object.}
\item{check}{A function that checks the object and returns it if it is valid. This operates on the R side and is mostly for development and debugging purposes. It is up to the developer to ensure that all functions return the correct type of object always.}
\item{generic}{logical, if \code{TRUE} then the object is a generic type.}
\item{x}{An object}
\item{which}{Which type to get, either "input" or "return"}
\item{type}{A ts object}
}
\description{
This is the base type for all typed objects. It is not meant to be used directly.
}
\section{Functions}{
\itemize{
\item \code{is_ts_object()}: Check if an object is a ts object
\item \code{get_type()}: Get the input type of a ts object
\item \code{check_type()}: Check if an object has the correct type
}}

15
man/ts_void.Rd Normal file
View File

@ -0,0 +1,15 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/types.R
\name{ts_void}
\alias{ts_void}
\title{Void type}
\usage{
ts_void()
}
\value{
A ts object that accepts \code{NULL}.
}
\description{
This is a type that accepts null values (this would typically be used for
functions that return nothing).
}

5
tests/testthat/app.d.ts vendored
View File

@ -1,5 +0,0 @@
import type { Character, Numeric, PE.Numeric<1>, } from 'rserve-ts';
const fn_first = (x: string | string[]) => Promise<Character<1>)>;
const fn_mean = (x: number | number[]) => Promise<Numeric<1>)>;
c("const sample_one = (x: number | number[]) => Promise<Numeric<1>)>;", "const sample_one = (x: string | string[]) => Promise<Character<1>)>;")

12
tests/testthat/functions.R
View File

@ -1,12 +0,0 @@
# overload input/return types
sample_num <- ts_function(
sample,
x = ts_numeric(0),
result = ts_numeric(1)
)
ts_compile(sample_num)
# compile to:
# const out = {
# sample_one: R.ocap([R.as_vector(z.number())], R.numeric(1)),
# };

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

@ -0,0 +1,2 @@
node_modules
app.rserve.*

41
tests/testthat/sampler/README.md Normal file
View File

@ -0,0 +1,41 @@
# Demo app
1. Installing R and the the `ts` package
```r
devtools::install_github("tmelliott/ts")
```
2. Install node and npm (or pnpm!), then install dependencies
```bash
pnpm install
```
3. Build dependencies
```bash
pnpm build
```
4. Start Rserve in a separate terminal
```bash
pnpm rserve
```
5. Run the app
```bash
pnpm start
```
You should see some output in the terminal:
```bash
Running sampler script...
Mean: 3
First char: hello
Sample num: Float64Array(2) [ 4, 3, r_type: 'double_array' ]
```

7
tests/testthat/app.R → tests/testthat/sampler/app.R
View File

@ -1,12 +1,13 @@
library(ts) library(ts)
fn_mean <- ts_function(mean, x = ts_numeric(), result = ts_numeric(1)) fn_mean <- ts_function(mean, x = ts_numeric(), result = ts_numeric(1))
fn_first <- ts_function(function(x) x[1], fn_first <- ts_function(function(x = ts_character()) x[1],
x = ts_character(-1), result = ts_character(1) result = ts_character(1)
) )
sample_num <- ts_function( sample_num <- ts_function(
sample, sample,
x = ts_numeric(0), x = ts_numeric(0),
result = ts_numeric(1) size = ts_integer(1),
result = ts_numeric()
) )

33
tests/testthat/sampler/app.ts Normal file
View File

@ -0,0 +1,33 @@
// var R = require("./node_modules/rserve-ts/dist/index.js").default;
// global.WebSocket = require("ws");
import RserveClient from "rserve-ts";
import WebSocket from "ws";
interface global {
WebSocket: typeof WebSocket;
}
global.WebSocket = WebSocket as any;
import appFuns from "./app.rserve";
async function main() {
const con = await RserveClient.create({
host: "http://127.0.0.1:6311",
});
const app = await con.ocap(appFuns);
const m = await app.fn_mean(new Float64Array([1, 2, 3, 4, 5]));
console.log("Mean:", m);
const f = await app.fn_first(["hello", "world"]);
console.log("First char:", f);
const s = await app.sample_num(new Float64Array([1, 2, 3, 4, 5]), 2);
console.log("Sample num:", s);
process.exit(0);
}
console.log("Running sampler script...\n");
main();

0
tests/testthat/sampler/index.js Normal file
View File

23
tests/testthat/sampler/package.json Normal file
View File

@ -0,0 +1,23 @@
{
"name": "sampler",
"version": "1.0.0",
"description": "",
"main": "app.js",
"scripts": {
"test": "echo \"Error: no test specified\" && exit 1",
"build": "Rscript -e 'ts::ts_compile(\"app.R\"); ts::ts_deploy(\"app.R\")'",
"rserve": "Rscript app.rserve.R",
"start": "ts-node app.ts"
},
"author": "",
"license": "ISC",
"dependencies": {
"@types/node": "^22.10.7",
"@types/ws": "^8.5.13",
"rserve-ts": "^0.6.1",
"ts-node": "^10.9.2",
"typescript": "^5.7.3",
"ws": "^8.18.0",
"zod": "^3.24.1"
}
}

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

@ -0,0 +1,219 @@
lockfileVersion: '9.0'
settings:
autoInstallPeers: true
excludeLinksFromLockfile: false
importers:
.:
dependencies:
'@types/node':
specifier: ^22.10.7
version: 22.10.7
'@types/ws':
specifier: ^8.5.13
version: 8.5.13
rserve-ts:
specifier: ^0.6.1
version: 0.6.1
ts-node:
specifier: ^10.9.2
version: 10.9.2(@types/node@22.10.7)(typescript@5.7.3)
typescript:
specifier: ^5.7.3
version: 5.7.3
ws:
specifier: ^8.18.0
version: 8.18.0
zod:
specifier: ^3.24.1
version: 3.24.1
packages:
'@cspotcode/source-map-support@0.8.1':
resolution: {integrity: sha512-IchNf6dN4tHoMFIn/7OE8LWZ19Y6q/67Bmf6vnGREv8RSbBVb9LPJxEcnwrcwX6ixSvaiGoomAUvu4YSxXrVgw==}
engines: {node: '>=12'}
'@jridgewell/resolve-uri@3.1.2':
resolution: {integrity: sha512-bRISgCIjP20/tbWSPWMEi54QVPRZExkuD9lJL+UIxUKtwVJA8wW1Trb1jMs1RFXo1CBTNZ/5hpC9QvmKWdopKw==}
engines: {node: '>=6.0.0'}
'@jridgewell/sourcemap-codec@1.5.0':
resolution: {integrity: sha512-gv3ZRaISU3fjPAgNsriBRqGWQL6quFx04YMPW/zD8XMLsU32mhCCbfbO6KZFLjvYpCZ8zyDEgqsgf+PwPaM7GQ==}
'@jridgewell/trace-mapping@0.3.9':
resolution: {integrity: sha512-3Belt6tdc8bPgAtbcmdtNJlirVoTmEb5e2gC94PnkwEW9jI6CAHUeoG85tjWP5WquqfavoMtMwiG4P926ZKKuQ==}
'@tsconfig/node10@1.0.11':
resolution: {integrity: sha512-DcRjDCujK/kCk/cUe8Xz8ZSpm8mS3mNNpta+jGCA6USEDfktlNvm1+IuZ9eTcDbNk41BHwpHHeW+N1lKCz4zOw==}
'@tsconfig/node12@1.0.11':
resolution: {integrity: sha512-cqefuRsh12pWyGsIoBKJA9luFu3mRxCA+ORZvA4ktLSzIuCUtWVxGIuXigEwO5/ywWFMZ2QEGKWvkZG1zDMTag==}
'@tsconfig/node14@1.0.3':
resolution: {integrity: sha512-ysT8mhdixWK6Hw3i1V2AeRqZ5WfXg1G43mqoYlM2nc6388Fq5jcXyr5mRsqViLx/GJYdoL0bfXD8nmF+Zn/Iow==}
'@tsconfig/node16@1.0.4':
resolution: {integrity: sha512-vxhUy4J8lyeyinH7Azl1pdd43GJhZH/tP2weN8TntQblOY+A0XbT8DJk1/oCPuOOyg/Ja757rG0CgHcWC8OfMA==}
'@types/node@22.10.7':
resolution: {integrity: sha512-V09KvXxFiutGp6B7XkpaDXlNadZxrzajcY50EuoLIpQ6WWYCSvf19lVIazzfIzQvhUN2HjX12spLojTnhuKlGg==}
'@types/ws@8.5.13':
resolution: {integrity: sha512-osM/gWBTPKgHV8XkTunnegTRIsvF6owmf5w+JtAfOw472dptdm0dlGv4xCt6GwQRcC2XVOvvRE/0bAoQcL2QkA==}
acorn-walk@8.3.4:
resolution: {integrity: sha512-ueEepnujpqee2o5aIYnvHU6C0A42MNdsIDeqy5BydrkuC5R1ZuUFnm27EeFJGoEHJQgn3uleRvmTXaJgfXbt4g==}
engines: {node: '>=0.4.0'}
acorn@8.14.0:
resolution: {integrity: sha512-cl669nCJTZBsL97OF4kUQm5g5hC2uihk0NxY3WENAC0TYdILVkAyHymAntgxGkl7K+t0cXIrH5siy5S4XkFycA==}
engines: {node: '>=0.4.0'}
hasBin: true
arg@4.1.3:
resolution: {integrity: sha512-58S9QDqG0Xx27YwPSt9fJxivjYl432YCwfDMfZ+71RAqUrZef7LrKQZ3LHLOwCS4FLNBplP533Zx895SeOCHvA==}
create-require@1.1.1:
resolution: {integrity: sha512-dcKFX3jn0MpIaXjisoRvexIJVEKzaq7z2rZKxf+MSr9TkdmHmsU4m2lcLojrj/FHl8mk5VxMmYA+ftRkP/3oKQ==}
diff@4.0.2:
resolution: {integrity: sha512-58lmxKSA4BNyLz+HHMUzlOEpg09FV+ev6ZMe3vJihgdxzgcwZ8VoEEPmALCZG9LmqfVoNMMKpttIYTVG6uDY7A==}
engines: {node: '>=0.3.1'}
make-error@1.3.6:
resolution: {integrity: sha512-s8UhlNe7vPKomQhC1qFelMokr/Sc3AgNbso3n74mVPA5LTZwkB9NlXf4XPamLxJE8h0gh73rM94xvwRT2CVInw==}
rserve-ts@0.6.1:
resolution: {integrity: sha512-oxT5ZttA/IExReAjZzKc80f8ug/y/xeIi2YhKSqvy9Hf7nQaQTmmtmDLfJ+vxqLuPRnhxHwjqhsjN2NpxDtLRw==}
ts-node@10.9.2:
resolution: {integrity: sha512-f0FFpIdcHgn8zcPSbf1dRevwt047YMnaiJM3u2w2RewrB+fob/zePZcrOyQoLMMO7aBIddLcQIEK5dYjkLnGrQ==}
hasBin: true
peerDependencies:
'@swc/core': '>=1.2.50'
'@swc/wasm': '>=1.2.50'
'@types/node': '*'
typescript: '>=2.7'
peerDependenciesMeta:
'@swc/core':
optional: true
'@swc/wasm':
optional: true
typescript@5.7.3:
resolution: {integrity: sha512-84MVSjMEHP+FQRPy3pX9sTVV/INIex71s9TL2Gm5FG/WG1SqXeKyZ0k7/blY/4FdOzI12CBy1vGc4og/eus0fw==}
engines: {node: '>=14.17'}
hasBin: true
underscore@1.13.7:
resolution: {integrity: sha512-GMXzWtsc57XAtguZgaQViUOzs0KTkk8ojr3/xAxXLITqf/3EMwxC0inyETfDFjH/Krbhuep0HNbbjI9i/q3F3g==}
undici-types@6.20.0:
resolution: {integrity: sha512-Ny6QZ2Nju20vw1SRHe3d9jVu6gJ+4e3+MMpqu7pqE5HT6WsTSlce++GQmK5UXS8mzV8DSYHrQH+Xrf2jVcuKNg==}
v8-compile-cache-lib@3.0.1:
resolution: {integrity: sha512-wa7YjyUGfNZngI/vtK0UHAN+lgDCxBPCylVXGp0zu59Fz5aiGtNXaq3DhIov063MorB+VfufLh3JlF2KdTK3xg==}
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
yn@3.1.1:
resolution: {integrity: sha512-Ux4ygGWsu2c7isFWe8Yu1YluJmqVhxqK2cLXNQA5AcC3QfbGNpM7fu0Y8b/z16pXLnFxZYvWhd3fhBY9DLmC6Q==}
engines: {node: '>=6'}
zod@3.24.1:
resolution: {integrity: sha512-muH7gBL9sI1nciMZV67X5fTKKBLtwpZ5VBp1vsOQzj1MhrBZ4wlVCm3gedKZWLp0Oyel8sIGfeiz54Su+OVT+A==}
snapshots:
'@cspotcode/source-map-support@0.8.1':
dependencies:
'@jridgewell/trace-mapping': 0.3.9
'@jridgewell/resolve-uri@3.1.2': {}
'@jridgewell/sourcemap-codec@1.5.0': {}
'@jridgewell/trace-mapping@0.3.9':
dependencies:
'@jridgewell/resolve-uri': 3.1.2
'@jridgewell/sourcemap-codec': 1.5.0
'@tsconfig/node10@1.0.11': {}
'@tsconfig/node12@1.0.11': {}
'@tsconfig/node14@1.0.3': {}
'@tsconfig/node16@1.0.4': {}
'@types/node@22.10.7':
dependencies:
undici-types: 6.20.0
'@types/ws@8.5.13':
dependencies:
'@types/node': 22.10.7
acorn-walk@8.3.4:
dependencies:
acorn: 8.14.0
acorn@8.14.0: {}
arg@4.1.3: {}
create-require@1.1.1: {}
diff@4.0.2: {}
make-error@1.3.6: {}
rserve-ts@0.6.1:
dependencies:
underscore: 1.13.7
zod: 3.24.1
ts-node@10.9.2(@types/node@22.10.7)(typescript@5.7.3):
dependencies:
'@cspotcode/source-map-support': 0.8.1
'@tsconfig/node10': 1.0.11
'@tsconfig/node12': 1.0.11
'@tsconfig/node14': 1.0.3
'@tsconfig/node16': 1.0.4
'@types/node': 22.10.7
acorn: 8.14.0
acorn-walk: 8.3.4
arg: 4.1.3
create-require: 1.1.1
diff: 4.0.2
make-error: 1.3.6
typescript: 5.7.3
v8-compile-cache-lib: 3.0.1
yn: 3.1.1
typescript@5.7.3: {}
underscore@1.13.7: {}
undici-types@6.20.0: {}
v8-compile-cache-lib@3.0.1: {}
ws@8.18.0: {}
yn@3.1.1: {}
zod@3.24.1: {}

15
tests/testthat/sampler/tsconfig.json Normal file
View File

@ -0,0 +1,15 @@
{
"compilerOptions": {
"target": "es2018",
"module": "commonjs",
"allowJs": true,
"noEmit": true,
"esModuleInterop": true,
"forceConsistentCasingInFileNames": true,
"strict": true,
"skipLibCheck": true
},
"ts-node": {
"files": true
}
}

107
tests/testthat/test-basic-types.R Normal file
View File

@ -0,0 +1,107 @@
test_that("boolean type", {
x <- ts_logical()
expect_equal(x$check(TRUE), TRUE)
expect_error(x$check(1))
x1 <- ts_logical(1)
expect_equal(x1$check(TRUE), TRUE)
expect_error(x1$check(c(TRUE, FALSE)))
x2 <- ts_logical(3)
expect_equal(x2$check(c(TRUE, FALSE, TRUE)), c(TRUE, FALSE, TRUE))
expect_error(x2$check(FALSE))
})
test_that("integer type", {
x <- ts_integer()
expect_equal(x$check(1L), 1L)
expect_equal(x$check(1:10), 1:10)
expect_error(x$check("a"))
expect_error(x$check(1.5))
x1 <- ts_integer(1)
expect_equal(x1$check(1L), 1L)
expect_error(x1$check(c(1L, 2L)))
x2 <- ts_integer(3)
expect_equal(x2$check(c(1:3)), c(1:3))
expect_error(x2$check(1L))
})
test_that("numeric type", {
x <- ts_numeric()
expect_equal(x$check(1), 1)
expect_equal(x$check(1:10 + 0.5), 1:10 + 0.5)
expect_error(x$check("a"))
x1 <- ts_numeric(1)
expect_equal(x1$check(1), 1)
expect_error(x1$check(c(1, 2)))
x2 <- ts_numeric(3)
expect_equal(x2$check(c(1, 2, 3)), c(1, 2, 3))
expect_error(x2$check(1))
})
test_that("character type", {
x <- ts_character()
expect_equal(x$check("a"), "a")
expect_equal(x$check(c("a", "b")), c("a", "b"))
expect_error(x$check(1))
x1 <- ts_character(1)
expect_equal(x1$check("a"), "a")
expect_error(x1$check(c("a", "b")))
x2 <- ts_character(3)
expect_equal(x2$check(c("a", "b", "c")), c("a", "b", "c"))
expect_error(x2$check("a"))
})
test_that("factor type (no levels)", {
x <- ts_factor()
expect_equal(x$check(factor("a")), factor("a"))
expect_error(x$check("a"))
expect_error(x$check(1))
})
test_that("factor type (with levels)", {
x <- ts_factor(levels = c("a", "b"))
expect_equal(
x$check(factor("a", levels = c("a", "b"))),
factor("a", levels = c("a", "b"))
)
expect_error(x$check(factor("a", levels = c("a"))))
expect_error(x$check("a"))
expect_error(x$check(1))
})
test_that("list type - default", {
x <- ts_list()
expect_equal(x$check(list()), list())
expect_equal(x$check(list(a = 1, b = 2)), list(a = 1, b = 2))
expect_error(x$check(1))
})
test_that("list type - named", {
x <- ts_list(a = ts_integer(1), b = ts_numeric(1))
expect_equal(x$check(list(a = 1L, b = 2)), list(a = 1L, b = 2))
expect_error(x$check(1))
expect_error(x$check(list()))
})
test_that("list type - unnamed", {
x <- ts_list(
ts_integer(1), ts_character(1),
ts_list(a = ts_integer(1))
)
expect_equal(x$check(list(
1L, "a",
list(a = 1L)
)), list(
1L, "a",
list(a = 1L)
))
expect_error(x$check(1))
expect_error(x$check(list()))
})

46
tests/testthat/test-compile.R Normal file
View File

@ -0,0 +1,46 @@
test_that("anonomous functions", {
add <- ts_function(
function(a = ts_numeric(1), b = ts_numeric(1)) a + b,
result = ts_numeric(1)
)
add_c <- ts_compile(add)
expect_equal(add_c, "const add = Robj.ocap([z.number(), z.number()], Robj.numeric(1));")
})
# test_that("Complex functions", {
# 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())
# )
# )
# sampler_c <- ts_compile(sampler)
# s <- sampler_c(1:10)
# expect_equal()
# })
test_that("Compile files", {
f <- tempfile(fileext = ".rserve.ts")
on.exit(unlink(f))
res <- ts_compile("sampler/app.R", file = f)
expect_true(file.exists(f))
})

6
tests/testthat/test-deploy.R Normal file
View File

@ -0,0 +1,6 @@
test_that("Deploy converts ts functions into valid ocap lists", {
f <- tempfile(fileext = ".rserve.R")
on.exit(unlink(f))
ts_deploy("sampler/app.R", file = f)
expect_true(file.exists(f))
})

68
tests/testthat/test-functions.R Normal file
View File

@ -0,0 +1,68 @@
# # optional, check arguments - useful for debugging/development
# check_args(match.call(), formals())
test_that("anonomous function definitions", {
add <- ts_function(
function(a = ts_numeric(1), b = ts_numeric(1)) a + b,
result = ts_numeric(1)
)
expect_equal(add$call(1, 2), 3)
expect_error(add$call("a", 2))
})
test_that("named function definitions", {
sample_num <- ts_function(
sample,
x = ts_numeric(),
result = ts_numeric()
)
x <- sample_num$call(1:10)
expect_true(all(x %in% 1:10))
expect_error(sample_num("a"))
})
test_that("void return types", {
print_x <- ts_function(
function(x = ts_numeric()) {
print(x)
return(NULL)
}
)
expect_output(z <- print_x$call(1:10))
expect_null(z)
})
test_that("function with complex return types", {
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())
)
)
s <- sampler$call(1:10)
expect_type(s$get$call(2), "integer")
expect_silent(s$set$call(100:200))
expect_gte(s$get$call(1), 100)
})