From 7a4f649e70164e222061fbb334c82cfe59cc39bb Mon Sep 17 00:00:00 2001 From: Tom Elliott Date: Tue, 7 Jan 2025 09:58:01 +1300 Subject: [PATCH 01/20] updating API --- R/compile.R | 4 ++-- R/types.R | 28 ++++++++++++++-------------- README.Rmd | 26 ++++++++++---------------- README.md | 32 +++++++++++++++----------------- man/object.Rd | 12 ++++++------ tests/testthat/functions.R | 23 +++++++++++++++++++---- 6 files changed, 66 insertions(+), 59 deletions(-) diff --git a/R/compile.R b/R/compile.R index 5c9e9d3..9d64aa7 100644 --- a/R/compile.R +++ b/R/compile.R @@ -8,10 +8,10 @@ ts_compile.ts_function <- function(f, name = deparse(substitute(f)), ...) { inputs <- attr(f, "args") result <- attr(f, "result") - inputs <- sapply(inputs, \(x) x$type) + inputs <- sapply(inputs, \(x) x$zod_type) fn_args <- paste(inputs) |> paste(collapse = ", ") - sprintf("const %s = R.ocap([%s], %s]);", name, fn_args, result$type_fn) + sprintf("const %s = R.ocap([%s], %s]);", name, fn_args, result$r_type) } # #' @export diff --git a/R/types.R b/R/types.R index 1e03ddd..e9daa2c 100644 --- a/R/types.R +++ b/R/types.R @@ -9,8 +9,8 @@ #' @param generic logical, if `TRUE` then the object is a generic type. #' #' @md -object <- function(type = "any", - type_fn = "any", +object <- function(zod_type = "any", + r_type = "any", default = NULL, check = function() stop("Not implemented"), generic = FALSE) { @@ -27,21 +27,21 @@ object <- function(type = "any", #' @export print.ts_object <- function(x, ...) { # name <- deparse(substitute(x)) - cat(sprintf("Input (ts) type: %s\n", x$type)) - cat(sprintf("Output (R) type: %s\n", x$type_fn)) + cat(sprintf("Zod type: %s\n", x$zod_type)) + cat(sprintf(" R type: %s\n", x$r_type)) } is_object <- function(x) { inherits(x, "ts_object") } -ts_union <- function(...) paste(..., sep = " | ") -ts_array <- function(type = c("number", "boolean", "string")) { - if (type == "number") { - return("Float64Array") +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 == "boolean") { - return("Uint8Array") + if (type == "z.boolean()") { + return("z.instanceof(Uint8Array)") } return("RTYPE.stringArray") } @@ -65,7 +65,7 @@ n_type_fun <- function(n, type) { #' @export ts_logical <- function(n = -1L) { object( - n_type(n, "boolean"), + n_type(n, "z.boolean()"), n_type_fun(n, "RTYPE.logical"), check = function(x) { if (!is.logical(x)) stop("Expected a boolean") @@ -78,7 +78,7 @@ ts_logical <- function(n = -1L) { #' @export ts_integer <- function(n = -1L) { object( - n_type(n, "number"), + n_type(n, "z.number()"), n_type_fun(n, "RTYPE.integer"), check = function(x) { if (!is.integer(x)) stop("Expected an integer") @@ -91,7 +91,7 @@ ts_integer <- function(n = -1L) { #' @export ts_numeric <- function(n = -1L) { object( - n_type(n, "number"), + n_type(n, "z.number()"), n_type_fun(n, "RTYPE.numeric"), check = function(x) { if (!is.numeric(x)) stop("Expected a number", call. = FALSE) @@ -106,7 +106,7 @@ ts_numeric <- function(n = -1L) { #' @export ts_character <- function(n = -1L) { object( - n_type(n, "string"), + n_type(n, "z.string()"), n_type_fun(n, "RTYPE.character"), check = function(x) { if (!is.character(x)) stop("Expected a string") diff --git a/README.Rmd b/README.Rmd index 9c5ae85..5626ab6 100644 --- a/README.Rmd +++ b/README.Rmd @@ -36,27 +36,24 @@ Writing functions is easy, just use the `ts_*()` functions to define formals and ```r library(ts) -app <- ts_app( +app <- ts_list( add = ts_fun( function(x, y) { x + y }, - x = ts_number(), - y = ts_number(), + x = ts_number(1), + y = ts_number(1), # 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... - result = ts_number() + result = r_numeric(1) ), sample = ts_fun( function(x, n) { sample(x, n) }, - x = ts_character_vector(), - n = ts_integer(), - result = ts_condition(n, - 1 = ts_character(), - ts_character_vector() - ) + x = ts_string(), + n = ts_number(1), + result = r_character() ) ) @@ -73,7 +70,7 @@ export const app = { z.promise(R.numeric(1)) ), sample: z.function( - z.tuple([z.character_vector(), z.integer()]), + z.tuple([z.array(z.string()), z.integer()]), z.promise(R.character()) ) }; @@ -82,11 +79,8 @@ export const app = { which will generate the following types: ```typescript type App = { - add: (x: number, y: number) => Promise<{ data: number }>; - sample: (x: string[], n: number) => Promise<{ data: string | string[] }>; - // or, if possible, even better: - sample: (x: string[], n: N) => - Promise<{ data: N extends 1 ? string : string[] }>; + add: (x: number, y: number) => Promise>; + sample: (x: string[], n: number) => Promise; }; ``` diff --git a/README.md b/README.md index 9e2d8cd..9edaf84 100644 --- a/README.md +++ b/README.md @@ -28,27 +28,24 @@ formals and return types. ``` r library(ts) -app <- ts_app( +app <- ts_list( add = ts_fun( function(x, y) { x + y }, - x = ts_number(), - y = ts_number(), + x = ts_number(1), + y = ts_number(1), # 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... - result = ts_number() + result = r_numeric(1) ), sample = ts_fun( function(x, n) { sample(x, n) }, - x = ts_character_vector(), - n = ts_integer(), - result = ts_condition(n, - 1 = ts_character(), - ts_character_vector() - ) + x = ts_string(), + n = ts_number(1), + result = r_character() ) ) @@ -66,7 +63,7 @@ export const app = { z.promise(R.numeric(1)) ), sample: z.function( - z.tuple([z.character_vector(), z.integer()]), + z.tuple([z.array(z.string()), z.integer()]), z.promise(R.character()) ) }; @@ -76,11 +73,8 @@ which will generate the following types: ``` typescript type App = { - add: (x: number, y: number) => Promise<{ data: number }>; - sample: (x: string[], n: number) => Promise<{ data: string | string[] }>; - // or, if possible, even better: - sample: (x: string[], n: N) => - Promise<{ data: N extends 1 ? string : string[] }>; + add: (x: number, y: number) => Promise>; + sample: (x: string[], n: number) => Promise; }; ``` @@ -113,7 +107,11 @@ cat(readLines("tests/testthat/app.R"), sep = "\n") #> ) ts_compile("tests/testthat/app.R", file = "") -#> Error in ts_compile.ts_function(e[[x]], file = file, name = x): unused argument (file = file) +#> import { stringArray, character, numeric } from 'rserve-ts'; +#> +#> const fn_first = R.ocap([z.union([z.string(), stringArray])], character(1)]); +#> const fn_mean = R.ocap([z.union([z.number(), z.instanceof(Float64Array)])], numeric(1)]); +#> const sample_num = R.ocap([z.instanceof(Float64Array)], numeric(1)]); ``` ## TODO diff --git a/man/object.Rd b/man/object.Rd index ce42aaf..816249b 100644 --- a/man/object.Rd +++ b/man/object.Rd @@ -5,23 +5,23 @@ \title{Typed object} \usage{ object( - type = "any", - type_fn = "any", + zod_type = "any", + r_type = "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.} + +\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.} } \description{ This is the base type for all typed objects. It is not meant to be used directly. diff --git a/tests/testthat/functions.R b/tests/testthat/functions.R index 27b38de..8fe3ae9 100644 --- a/tests/testthat/functions.R +++ b/tests/testthat/functions.R @@ -4,9 +4,24 @@ sample_num <- ts_function( x = ts_numeric(0), result = ts_numeric(1) ) -ts_compile(sample_num) + +sampler <- ts_function( + function() { + list( + sample_one = sample_num(0) + ) + }, + result = ts_list( + num = sample_num + ) +) + +ts_compile(d_normal) # compile to: -# const out = { -# sample_one: R.ocap([R.as_vector(z.number())], R.numeric(1)), -# }; +# const sampler = R.ocap( +# [], +# R.list({ +# num: R.ocap([], R.numeric(1)) +# }) +# ); From 639a7779c94fb25a0ca5bd4bfcabd722f87273d0 Mon Sep 17 00:00:00 2001 From: Tom Elliott Date: Wed, 8 Jan 2025 09:00:37 +1300 Subject: [PATCH 02/20] some tests; working on fn api --- R/function.R | 47 +++++++++++++++++++++++------------------------ R/types.R | 15 ++++++++++----- README.Rmd | 10 ++-------- 3 files changed, 35 insertions(+), 37 deletions(-) diff --git a/R/function.R b/R/function.R index 08cc20f..f769620 100644 --- a/R/function.R +++ b/R/function.R @@ -14,10 +14,32 @@ parse_args <- function(x, mc) { 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 #' #' @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) #' @export ts_function <- function(f, ..., result = NULL) { @@ -25,17 +47,6 @@ ts_function <- function(f, ..., result = NULL) { if (!is.null(result) && !is_object(result)) { 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(...) { mc <- match.call(f) @@ -47,15 +58,3 @@ ts_function <- function(f, ..., result = NULL) { class(fn) <- c("ts_function", class(f)) fn } - -# #' @export -# is_overload <- function(x) { -# sapply(x, inherits, what = "ts_overload") -# } - -# #' @export -# ts_overload <- function(..., result = NULL) { -# structure(list(args = list(...), result = result), -# class = "ts_overload" -# ) -# } diff --git a/R/types.R b/R/types.R index e9daa2c..dd13e1c 100644 --- a/R/types.R +++ b/R/types.R @@ -139,7 +139,10 @@ ts_factor <- function(levels = NULL) { check = function(x) { if (!is.factor(x)) stop("Expected a factor") 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 } @@ -155,11 +158,11 @@ ts_factor <- function(levels = NULL) { #' @export #' @md ts_list <- function(values = NULL) { - type <- "[]" + type <- "z.union([z.object({}), z.array(z.any())])" type_fn <- "" if (!is.null(values)) { - types <- sapply(values, function(x) x$type) - type_funs <- sapply(values, function(x) x$type_fn) + types <- sapply(values, function(x) x$zod_type) + type_funs <- sapply(values, function(x) x$r_type) if (!is.null(names(values))) { type <- sprintf( "{%s}", @@ -177,7 +180,9 @@ ts_list <- function(values = NULL) { object( type, - sprintf("List<%s>", type_fn), + ifelse(type_fn == "", "RTYPE.List", + sprintf("RTYPE.List<%s>", type_fn) + ), check = function(x) { if (!is.list(x)) stop("Expected a list") x diff --git a/README.Rmd b/README.Rmd index 5626ab6..1e69eeb 100644 --- a/README.Rmd +++ b/README.Rmd @@ -38,14 +38,8 @@ Writing functions is easy, just use the `ts_*()` functions to define formals and library(ts) app <- ts_list( add = ts_fun( - function(x, y) { - x + y - }, - x = ts_number(1), - y = ts_number(1), - # 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... - result = r_numeric(1) + function(x = ts_number(1), y = ts_number(1)) a + b, + ts_numeric(1) ), sample = ts_fun( function(x, n) { From 16ed412cd75d586d1be38bd1bbd52be0795eef95 Mon Sep 17 00:00:00 2001 From: Tom Elliott Date: Wed, 8 Jan 2025 16:02:59 +1300 Subject: [PATCH 03/20] update types for new api --- DESCRIPTION | 5 +- Makefile | 3 + R/types.R | 93 +++++++++++++++++--------- man/object.Rd | 12 ++-- man/ts_function.Rd | 2 +- tests/testthat/test-basic-types.R | 107 ++++++++++++++++++++++++++++++ tests/testthat/test-functions.R | 12 ++++ 7 files changed, 194 insertions(+), 40 deletions(-) create mode 100644 tests/testthat/test-basic-types.R create mode 100644 tests/testthat/test-functions.R diff --git a/DESCRIPTION b/DESCRIPTION index 151766c..b9283ba 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -10,6 +10,9 @@ License: MIT + file LICENSE Encoding: UTF-8 Roxygen: list(markdown = TRUE) RoxygenNote: 7.3.1 -Suggests: +Suggests: testthat (>= 3.0.0) Config/testthat/edition: 3 +Imports: + cli, + js diff --git a/Makefile b/Makefile index 895931c..9c45c42 100644 --- a/Makefile +++ b/Makefile @@ -11,3 +11,6 @@ install: document README.md: README.Rmd install Rscript -e "rmarkdown::render('README.Rmd')" @rm README.html + +test: + Rscript -e "devtools::test()" diff --git a/R/types.R b/R/types.R index dd13e1c..0e77ca0 100644 --- a/R/types.R +++ b/R/types.R @@ -2,15 +2,15 @@ #' #' 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 type_fn The type of the object that Typescript expects to recieve from R. +#' @param input_type The type of the object that Typescript expect to send to 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 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. #' #' @md -object <- function(zod_type = "any", - r_type = "any", +object <- function(input_type = "any", + return_type = "any", default = NULL, check = function() stop("Not implemented"), generic = FALSE) { @@ -27,8 +27,20 @@ object <- function(zod_type = "any", #' @export print.ts_object <- function(x, ...) { # name <- deparse(substitute(x)) - cat(sprintf("Zod type: %s\n", x$zod_type)) - cat(sprintf(" R type: %s\n", x$r_type)) + cli::cli_ul() + 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) { + cat(js::uglify_reformat(x$return_type, beautify = TRUE), "\n") + } else { + cat(x$return_type, "\n") + } + cli::cli_end() } is_object <- function(x) { @@ -43,7 +55,7 @@ ts_array <- function(type = c("z.number()", "z.boolean()", "z.string()")) { if (type == "z.boolean()") { return("z.instanceof(Uint8Array)") } - return("RTYPE.stringArray") + return("Robj.character(0)") } n_type <- function(n, type, pl = ts_array(type)) { @@ -56,20 +68,19 @@ n_type <- function(n, type, pl = ts_array(type)) { pl } n_type_fun <- function(n, type) { - if (n < 0) { - return(type) - } - sprintf("%s(%s)", type, n) + sprintf("%s(%s)", type, ifelse(n < 0, "", n)) } #' @export ts_logical <- function(n = -1L) { object( n_type(n, "z.boolean()"), - n_type_fun(n, "RTYPE.logical"), + n_type_fun(n, "Robj.logical"), check = function(x) { 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 } ) @@ -79,10 +90,12 @@ ts_logical <- function(n = -1L) { ts_integer <- function(n = -1L) { object( n_type(n, "z.number()"), - n_type_fun(n, "RTYPE.integer"), + n_type_fun(n, "Robj.integer"), check = function(x) { if (!is.integer(x)) stop("Expected an integer") - if (n > 0 && length(x) != n) stop("Expected an integer of length ", n) + if (n > 0 && length(x) != n) { + stop("Expected an integer of length ", n) + } x } ) @@ -92,7 +105,7 @@ ts_integer <- function(n = -1L) { ts_numeric <- function(n = -1L) { object( n_type(n, "z.number()"), - n_type_fun(n, "RTYPE.numeric"), + n_type_fun(n, "Robj.numeric"), check = function(x) { if (!is.numeric(x)) stop("Expected a number", call. = FALSE) if (n > 0 && length(x) != n) { @@ -107,7 +120,7 @@ ts_numeric <- function(n = -1L) { ts_character <- function(n = -1L) { object( n_type(n, "z.string()"), - n_type_fun(n, "RTYPE.character"), + n_type_fun(n, "Robj.character"), check = function(x) { if (!is.character(x)) stop("Expected a string") if (n > 0 && length(x) != n) stop("Expected a string of length ", n) @@ -130,11 +143,14 @@ vector_as_ts_array <- function(x) { #' @md ts_factor <- function(levels = NULL) { object( - sprintf("(%s)[]", paste(levels, collapse = " | ")), + ifelse(is.null(levels), + ts_array("z.string()"), + sprintf("(%s)[]", paste(levels, collapse = " | ")) + ), if (is.null(levels)) { - "Factor" + "Robj.factor()" } else { - sprintf("Factor<%s>", vector_as_ts_array(levels)) + sprintf("Robj.factor(%s)", vector_as_ts_array(levels)) }, check = function(x) { if (!is.factor(x)) stop("Expected a factor") @@ -161,30 +177,43 @@ ts_list <- function(values = NULL) { type <- "z.union([z.object({}), z.array(z.any())])" type_fn <- "" if (!is.null(values)) { - types <- sapply(values, function(x) x$zod_type) - type_funs <- sapply(values, function(x) x$r_type) + types <- sapply(values, function(x) x$input_type) + type_funs <- sapply(values, function(x) x$return_type) if (!is.null(names(values))) { type <- sprintf( - "{%s}", + "{ %s }", paste(names(values), types, sep = ": ", collapse = ", ") ) type_fn <- sprintf( - "{%s}", + "{ %s }", paste(names(values), type_funs, sep = ": ", collapse = ", ") ) } else { - type <- sprintf("[%s]", paste(values, collapse = ", ")) + type <- sprintf("[%s]", paste(types, collapse = ", ")) type_fn <- sprintf("[%s]", paste(type_funs, collapse = ", ")) } } object( type, - ifelse(type_fn == "", "RTYPE.List", - sprintf("RTYPE.List<%s>", type_fn) + ifelse(type_fn == "", "Robj.list()", + sprintf("Robj.list(%s)", type_fn) ), check = function(x) { 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)) { + values[[i]]$check(x[[i]]) + } + } x } ) @@ -199,15 +228,15 @@ ts_list <- function(values = NULL) { #' @md ts_dataframe <- function(...) { values <- list(...) - type <- "{}" + type <- "z.record(z.string(), z.any())" type_fn <- "" if (length(values)) { - types <- sapply(values, function(x) x$type) - type_funs <- sapply(values, function(x) x$type_fn) + types <- sapply(values, function(x) x$input_type) + type_funs <- sapply(values, function(x) x$return_type) if (is.null(names(values))) stop("Expected named elements") type <- sprintf( - "{\n %s\n}", + "z.object({\n %s\n})", paste(names(values), types, sep = ": ", collapse = ",\n ") ) type_fn <- sprintf( @@ -218,7 +247,7 @@ ts_dataframe <- function(...) { object( type, - sprintf("List<%s>", type), + sprintf("R.dataframe(%s)", type_fn), check = function(x) { if (!is.data.frame(x)) stop("Expected a data frame") x diff --git a/man/object.Rd b/man/object.Rd index 816249b..dbb74eb 100644 --- a/man/object.Rd +++ b/man/object.Rd @@ -5,23 +5,23 @@ \title{Typed object} \usage{ object( - zod_type = "any", - r_type = "any", + input_type = "any", + return_type = "any", default = NULL, check = function() stop("Not implemented"), generic = FALSE ) } \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{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.} } \description{ This is the base type for all typed objects. It is not meant to be used directly. diff --git a/man/ts_function.Rd b/man/ts_function.Rd index 61df748..d36d22f 100644 --- a/man/ts_function.Rd +++ b/man/ts_function.Rd @@ -9,7 +9,7 @@ ts_function(f, ..., result = NULL) \arguments{ \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)} } diff --git a/tests/testthat/test-basic-types.R b/tests/testthat/test-basic-types.R new file mode 100644 index 0000000..88a5e7f --- /dev/null +++ b/tests/testthat/test-basic-types.R @@ -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(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(list( + ts_integer(1), ts_character(1), + ts_list(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())) +}) diff --git a/tests/testthat/test-functions.R b/tests/testthat/test-functions.R new file mode 100644 index 0000000..dd1a15b --- /dev/null +++ b/tests/testthat/test-functions.R @@ -0,0 +1,12 @@ +# # optional, check arguments - useful for debugging/development +# check_args(match.call(), formals()) + +# test_that("function definitions", { +# add <- ts_fun( +# function(a = ts_numeric(1), b = ts_numeric(1)) a + b, +# result = ts_numeric(1) +# ) + +# expect_equal(add(1, 2), 3) +# expect_error(add("a", 2)) +# }) From 1a3d6de032a23e745c4e5e6a784907fe918efd1f Mon Sep 17 00:00:00 2001 From: Tom Elliott Date: Thu, 9 Jan 2025 12:58:49 +1300 Subject: [PATCH 04/20] test functions --- R/function.R | 13 ++++++++++++- tests/testthat/test-functions.R | 16 ++++++++-------- 2 files changed, 20 insertions(+), 9 deletions(-) diff --git a/R/function.R b/R/function.R index f769620..37fa9fb 100644 --- a/R/function.R +++ b/R/function.R @@ -8,7 +8,14 @@ parse_args <- function(x, mc) { ) } 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) args @@ -48,6 +55,10 @@ ts_function <- function(f, ..., result = NULL) { stop("Invalid return type") } + if (length(args) == 0) { + args <- lapply(formals(f), eval) + } + fn <- function(...) { mc <- match.call(f) x <- parse_args(args, mc) diff --git a/tests/testthat/test-functions.R b/tests/testthat/test-functions.R index dd1a15b..0560c45 100644 --- a/tests/testthat/test-functions.R +++ b/tests/testthat/test-functions.R @@ -1,12 +1,12 @@ # # optional, check arguments - useful for debugging/development # check_args(match.call(), formals()) -# test_that("function definitions", { -# add <- ts_fun( -# function(a = ts_numeric(1), b = ts_numeric(1)) a + b, -# result = ts_numeric(1) -# ) +test_that("function definitions", { + add <- ts_function( + function(a = ts_numeric(1), b = ts_numeric(1)) a + b, + result = ts_numeric(1) + ) -# expect_equal(add(1, 2), 3) -# expect_error(add("a", 2)) -# }) + expect_equal(add(1, 2), 3) + expect_error(add("a", 2)) +}) From 9be1c72a0391471373543b295439eb54e7c4c366 Mon Sep 17 00:00:00 2001 From: Tom Elliott Date: Thu, 9 Jan 2025 15:11:03 +1300 Subject: [PATCH 05/20] renaming; change from values to ... for list() --- R/function.R | 2 +- R/types.R | 35 ++++++++++++++++++------------- tests/testthat/test-basic-types.R | 8 +++---- 3 files changed, 25 insertions(+), 20 deletions(-) diff --git a/R/function.R b/R/function.R index 37fa9fb..e328d0b 100644 --- a/R/function.R +++ b/R/function.R @@ -51,7 +51,7 @@ ts_result <- function(type, value) { #' @export ts_function <- function(f, ..., result = NULL) { args <- list(...) - if (!is.null(result) && !is_object(result)) { + if (!is.null(result) && !is_ts_object(result)) { stop("Invalid return type") } diff --git a/R/types.R b/R/types.R index 0e77ca0..3dd65c2 100644 --- a/R/types.R +++ b/R/types.R @@ -9,11 +9,11 @@ #' @param generic logical, if `TRUE` then the object is a generic type. #' #' @md -object <- function(input_type = "any", - return_type = "any", - default = NULL, - check = function() stop("Not implemented"), - generic = FALSE) { +ts_object <- function(input_type = "any", + return_type = "any", + default = NULL, + check = function() stop("Not implemented"), + generic = FALSE) { e <- environment() e$attr <- function(name, value) { @@ -43,7 +43,9 @@ print.ts_object <- function(x, ...) { cli::cli_end() } -is_object <- function(x) { +#' @describeIn object Check if an object is a ts object +#' @export +is_ts_object <- function(x) { inherits(x, "ts_object") } @@ -73,7 +75,7 @@ n_type_fun <- function(n, type) { #' @export ts_logical <- function(n = -1L) { - object( + ts_object( n_type(n, "z.boolean()"), n_type_fun(n, "Robj.logical"), check = function(x) { @@ -88,7 +90,7 @@ ts_logical <- function(n = -1L) { #' @export ts_integer <- function(n = -1L) { - object( + ts_object( n_type(n, "z.number()"), n_type_fun(n, "Robj.integer"), check = function(x) { @@ -103,7 +105,7 @@ ts_integer <- function(n = -1L) { #' @export ts_numeric <- function(n = -1L) { - object( + ts_object( n_type(n, "z.number()"), n_type_fun(n, "Robj.numeric"), check = function(x) { @@ -118,7 +120,7 @@ ts_numeric <- function(n = -1L) { #' @export ts_character <- function(n = -1L) { - object( + ts_object( n_type(n, "z.string()"), n_type_fun(n, "Robj.character"), check = function(x) { @@ -142,7 +144,7 @@ vector_as_ts_array <- function(x) { #' @export #' @md ts_factor <- function(levels = NULL) { - object( + ts_object( ifelse(is.null(levels), ts_array("z.string()"), sprintf("(%s)[]", paste(levels, collapse = " | ")) @@ -170,13 +172,16 @@ ts_factor <- function(levels = NULL) { #' Typed list #' #' A list is a vector of other robjects, which may or may not be named. +#' @param ... A list of types, named or unnamed. #' #' @export #' @md -ts_list <- function(values = NULL) { +ts_list <- function(...) { + values <- list(...) + type <- "z.union([z.object({}), z.array(z.any())])" type_fn <- "" - if (!is.null(values)) { + if (length(values)) { types <- sapply(values, function(x) x$input_type) type_funs <- sapply(values, function(x) x$return_type) if (!is.null(names(values))) { @@ -194,7 +199,7 @@ ts_list <- function(values = NULL) { } } - object( + ts_object( type, ifelse(type_fn == "", "Robj.list()", sprintf("Robj.list(%s)", type_fn) @@ -245,7 +250,7 @@ ts_dataframe <- function(...) { ) } - object( + ts_object( type, sprintf("R.dataframe(%s)", type_fn), check = function(x) { diff --git a/tests/testthat/test-basic-types.R b/tests/testthat/test-basic-types.R index 88a5e7f..7570524 100644 --- a/tests/testthat/test-basic-types.R +++ b/tests/testthat/test-basic-types.R @@ -84,17 +84,17 @@ test_that("list type - default", { }) test_that("list type - named", { - x <- ts_list(list(a = ts_integer(1), b = ts_numeric(1))) + 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(list( + x <- ts_list( ts_integer(1), ts_character(1), - ts_list(list(a = ts_integer(1))) - )) + ts_list(a = ts_integer(1)) + ) expect_equal(x$check(list( 1L, "a", list(a = 1L) From 57cdc92a2a1c56a90eade18160779b3044b90c40 Mon Sep 17 00:00:00 2001 From: Tom Elliott Date: Fri, 10 Jan 2025 09:20:28 +1300 Subject: [PATCH 06/20] eugh --- tests/testthat/functions.R | 19 +++---------------- tests/testthat/test-functions.R | 33 ++++++++++++++++++++++++++++++++- 2 files changed, 35 insertions(+), 17 deletions(-) diff --git a/tests/testthat/functions.R b/tests/testthat/functions.R index 8fe3ae9..f6216c8 100644 --- a/tests/testthat/functions.R +++ b/tests/testthat/functions.R @@ -1,22 +1,9 @@ # overload input/return types -sample_num <- ts_function( - sample, - x = ts_numeric(0), - result = ts_numeric(1) -) -sampler <- ts_function( - function() { - list( - sample_one = sample_num(0) - ) - }, - result = ts_list( - num = sample_num - ) -) -ts_compile(d_normal) + + +# ts_compile(d_normal) # compile to: # const sampler = R.ocap( diff --git a/tests/testthat/test-functions.R b/tests/testthat/test-functions.R index 0560c45..7027171 100644 --- a/tests/testthat/test-functions.R +++ b/tests/testthat/test-functions.R @@ -1,7 +1,7 @@ # # optional, check arguments - useful for debugging/development # check_args(match.call(), formals()) -test_that("function definitions", { +test_that("anonomous function definitions", { add <- ts_function( function(a = ts_numeric(1), b = ts_numeric(1)) a + b, result = ts_numeric(1) @@ -10,3 +10,34 @@ test_that("function definitions", { expect_equal(add(1, 2), 3) expect_error(add("a", 2)) }) + +test_that("named function definitions", { + sample_num <- ts_function( + sample, + x = ts_numeric(), + result = ts_numeric() + ) + + x <- sample_num(1:10) + expect_true(all(x %in% 1:10)) + expect_error(sample_num("a")) +}) + +test_that("function with complex return types", { + sampler <- ts_function( + function(x = ts_numeric()) { + list( + get = function(n) sample(x, n) + ) + }, + result = ts_list( + get = ts_function( + NULL, + n = ts_integer(1), + result = ts_numeric(1) + ) + ) + ) + + s <- sampler(1:10) +}) From cdbf155b575af91e7d33696726e185ad90436e9a Mon Sep 17 00:00:00 2001 From: Tom Elliott Date: Thu, 16 Jan 2025 12:25:56 +1300 Subject: [PATCH 07/20] ts_function method for defining ocaps --- .Rbuildignore | 1 + DESCRIPTION | 3 +- NAMESPACE | 12 ++++ R/function.R | 48 ++++++++++++---- R/types.R | 98 +++++++++++++++++++++++++++++++-- README.Rmd | 30 ++++++---- man/ts_function.Rd | 2 +- man/ts_list.Rd | 5 +- man/{object.Rd => ts_object.Rd} | 30 +++++++++- tests/testthat/test-functions.R | 49 +++++++++++++---- 10 files changed, 232 insertions(+), 46 deletions(-) rename man/{object.Rd => ts_object.Rd} (63%) diff --git a/.Rbuildignore b/.Rbuildignore index 2a2cb83..b0dba58 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -1,2 +1,3 @@ ^LICENSE\.md$ ^README\.Rmd$ +^Makefile$ diff --git a/DESCRIPTION b/DESCRIPTION index b9283ba..05098ce 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -15,4 +15,5 @@ Suggests: Config/testthat/edition: 3 Imports: cli, - js + js, + rlang diff --git a/NAMESPACE b/NAMESPACE index bda2ac1..3eb7ff1 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,9 +1,19 @@ # 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(ts_compile,character) S3method(ts_compile,default) S3method(ts_compile,ts_function) +export(check_type) +export(get_type) +export(is_ts_object) export(ts_character) export(ts_compile) export(ts_dataframe) @@ -12,4 +22,6 @@ export(ts_function) export(ts_integer) export(ts_list) export(ts_logical) +export(ts_null) export(ts_numeric) +export(ts_void) diff --git a/R/function.R b/R/function.R index e328d0b..8dafc57 100644 --- a/R/function.R +++ b/R/function.R @@ -1,6 +1,5 @@ parse_args <- function(x, mc) { fmls <- lapply(x, eval) - mc <- mc[-1] if (!all(names(mc) %in% names(fmls))) { stop( "Invalid argument(s): ", @@ -49,7 +48,7 @@ ts_result <- function(type, value) { #' @param ... argument definitions (only required if f does not specify these in its formals) #' @param result return type (ignored if overloads are provided) #' @export -ts_function <- function(f, ..., result = NULL) { +ts_function <- function(f, ..., result = ts_void()) { args <- list(...) if (!is.null(result) && !is_ts_object(result)) { stop("Invalid return type") @@ -59,13 +58,42 @@ ts_function <- function(f, ..., result = NULL) { args <- lapply(formals(f), eval) } - fn <- function(...) { - mc <- match.call(f) - x <- parse_args(args, mc) - result$check(do.call(f, x)) + e <- new.env() + e$f <- f + # 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) } - attr(fn, "args") <- args - attr(fn, "result") <- result - class(fn) <- c("ts_function", class(f)) - fn + + 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 +print.ts_function <- function(x, ...) { + 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) } diff --git a/R/types.R b/R/types.R index 3dd65c2..ddf9182 100644 --- a/R/types.R +++ b/R/types.R @@ -36,6 +36,7 @@ print.ts_object <- function(x, ...) { } 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") @@ -43,12 +44,74 @@ print.ts_object <- function(x, ...) { cli::cli_end() } -#' @describeIn object Check if an object is a ts object +#' @describeIn ts_object Check if an object is a ts object #' @export is_ts_object <- function(x) { inherits(x, "ts_object") } +#' @describeIn ts_object Get the input type of a ts object +#' @param x A ts object +#' @param which Which type to get, either "input" or "return" +#' @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) + } + x$return_type +} + +#' @export +get_type.ts_function <- function(x, which = c("input", "return")) { + which <- match.arg(which) + if (which == "input") { + return("z.function()") + } + "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()") { @@ -182,8 +245,8 @@ ts_list <- function(...) { type <- "z.union([z.object({}), z.array(z.any())])" type_fn <- "" if (length(values)) { - types <- sapply(values, function(x) x$input_type) - type_funs <- sapply(values, function(x) x$return_type) + types <- sapply(values, get_type, which = "input") + type_funs <- sapply(values, get_type, which = "return") if (!is.null(names(values))) { type <- sprintf( "{ %s }", @@ -216,7 +279,7 @@ ts_list <- function(...) { } } for (i in seq_along(values)) { - values[[i]]$check(x[[i]]) + x[[i]] <- check_type(values[[i]], x[[i]]) } } x @@ -236,8 +299,8 @@ ts_dataframe <- function(...) { type <- "z.record(z.string(), z.any())" type_fn <- "" if (length(values)) { - types <- sapply(values, function(x) x$input_type) - type_funs <- sapply(values, function(x) x$return_type) + types <- sapply(values, get_type, which = "input") + type_funs <- sapply(values, get_type, which = "return") if (is.null(names(values))) stop("Expected named elements") type <- sprintf( @@ -259,3 +322,26 @@ ts_dataframe <- function(...) { } ) } + +#' @export +ts_null <- function() { + ts_object( + "z.null()", + "Robj.null()", + check = function(x) { + if (!is.null(x)) stop("Expected NULL") + x + } + ) +} + +#' @export +ts_void <- function() { + ts_object( + "z.void()", + "null", + check = function(x) { + return(NULL) + } + ) +} diff --git a/README.Rmd b/README.Rmd index 1e69eeb..0d8f6b6 100644 --- a/README.Rmd +++ b/README.Rmd @@ -36,18 +36,24 @@ Writing functions is easy, just use the `ts_*()` functions to define formals and ```r library(ts) -app <- ts_list( - add = ts_fun( - function(x = ts_number(1), y = ts_number(1)) a + b, - ts_numeric(1) - ), - sample = ts_fun( - function(x, n) { - sample(x, n) - }, - x = ts_string(), - n = ts_number(1), - result = r_character() +addFn <- ts_function( + function(a = ts_numeric(1), b = ts_numeric(1)) a + b, + result = ts_numeric(1) +) +sampleFn <- ts_function( + function(x = ts_character(), n = ts_integer(1)) sample(x, n), + result = ts_character() +) +app <- ts_function( + function() { + list( + add = addFn, + sample = sampleFn + ) + }, + result = ts_list( + add = appFn, + sample = sampleFn ) ) diff --git a/man/ts_function.Rd b/man/ts_function.Rd index d36d22f..2daaba5 100644 --- a/man/ts_function.Rd +++ b/man/ts_function.Rd @@ -4,7 +4,7 @@ \alias{ts_function} \title{TS function definition} \usage{ -ts_function(f, ..., result = NULL) +ts_function(f, ..., result = ts_void()) } \arguments{ \item{f}{an R function} diff --git a/man/ts_list.Rd b/man/ts_list.Rd index c8e708d..dd6cb7a 100644 --- a/man/ts_list.Rd +++ b/man/ts_list.Rd @@ -4,7 +4,10 @@ \alias{ts_list} \title{Typed list} \usage{ -ts_list(values = NULL) +ts_list(...) +} +\arguments{ +\item{...}{A list of types, named or unnamed.} } \description{ A list is a vector of other robjects, which may or may not be named. diff --git a/man/object.Rd b/man/ts_object.Rd similarity index 63% rename from man/object.Rd rename to man/ts_object.Rd index dbb74eb..bbb2dca 100644 --- a/man/object.Rd +++ b/man/ts_object.Rd @@ -1,16 +1,25 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/types.R -\name{object} -\alias{object} +\name{ts_object} +\alias{ts_object} +\alias{is_ts_object} +\alias{get_type} +\alias{check_type} \title{Typed object} \usage{ -object( +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.} @@ -22,7 +31,22 @@ 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 + +}} diff --git a/tests/testthat/test-functions.R b/tests/testthat/test-functions.R index 7027171..0bde1cd 100644 --- a/tests/testthat/test-functions.R +++ b/tests/testthat/test-functions.R @@ -7,8 +7,8 @@ test_that("anonomous function definitions", { result = ts_numeric(1) ) - expect_equal(add(1, 2), 3) - expect_error(add("a", 2)) + expect_equal(add$call(1, 2), 3) + expect_error(add$call("a", 2)) }) test_that("named function definitions", { @@ -18,26 +18,51 @@ test_that("named function definitions", { result = ts_numeric() ) - x <- sample_num(1:10) + x <- sample_num$call(1:10) expect_true(all(x %in% 1:10)) expect_error(sample_num("a")) }) -test_that("function with complex return types", { - sampler <- ts_function( +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 = function(n) sample(x, n) + get = get_sample$copy(), + set = ts_function( + function(value = ts_numeric()) { + values <<- value + } + ) ) }, result = ts_list( - get = ts_function( - NULL, - n = ts_integer(1), - result = ts_numeric(1) - ) + get = get_sample, + set = ts_function(NULL, value = ts_numeric()) ) ) - s <- sampler(1:10) + 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) }) From 245584d30bf3d10609bd6ce58ddd0a22b137d33a Mon Sep 17 00:00:00 2001 From: Tom Elliott Date: Thu, 16 Jan 2025 13:54:42 +1300 Subject: [PATCH 08/20] update readme --- README.md | 48 ++++++++++++++++++++++++------------------------ 1 file changed, 24 insertions(+), 24 deletions(-) diff --git a/README.md b/README.md index 9edaf84..85f8e8b 100644 --- a/README.md +++ b/README.md @@ -28,24 +28,24 @@ formals and return types. ``` r library(ts) -app <- ts_list( - add = ts_fun( - function(x, y) { - x + y - }, - x = ts_number(1), - y = ts_number(1), - # 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... - result = r_numeric(1) - ), - sample = ts_fun( - function(x, n) { - sample(x, n) - }, - x = ts_string(), - n = ts_number(1), - result = r_character() +addFn <- ts_function( + function(a = ts_numeric(1), b = ts_numeric(1)) a + b, + result = ts_numeric(1) +) +sampleFn <- ts_function( + function(x = ts_character(), n = ts_integer(1)) sample(x, n), + result = ts_character() +) +app <- ts_function( + function() { + list( + add = addFn, + sample = sampleFn + ) + }, + result = ts_list( + add = appFn, + sample = sampleFn ) ) @@ -87,10 +87,10 @@ library(ts) myfun <- ts_function(mean, x = ts_numeric(), result = ts_numeric(1)) myfun(1:5) -#> [1] 3 +#> Error in myfun(1:5): could not find function "myfun" myfun("hello world") -#> Error: Expected a number +#> Error in myfun("hello world"): could not find function "myfun" cat(readLines("tests/testthat/app.R"), sep = "\n") #> library(ts) @@ -107,11 +107,11 @@ cat(readLines("tests/testthat/app.R"), sep = "\n") #> ) ts_compile("tests/testthat/app.R", file = "") -#> import { stringArray, character, numeric } from 'rserve-ts'; +#> import { } from 'rserve-ts'; #> -#> const fn_first = R.ocap([z.union([z.string(), stringArray])], character(1)]); -#> const fn_mean = R.ocap([z.union([z.number(), z.instanceof(Float64Array)])], numeric(1)]); -#> const sample_num = R.ocap([z.instanceof(Float64Array)], numeric(1)]); +#> character(0) +#> character(0) +#> character(0) ``` ## TODO From 7dfe4c3c50892cffc8cbe21c3e5c160a8df08fc3 Mon Sep 17 00:00:00 2001 From: Tom Elliott Date: Thu, 16 Jan 2025 15:08:13 +1300 Subject: [PATCH 09/20] update readme with outline for next step --- R/compile.R | 7 ------- README.Rmd | 7 +++++++ tests/testthat/test-functions.R | 4 ++++ 3 files changed, 11 insertions(+), 7 deletions(-) diff --git a/R/compile.R b/R/compile.R index 9d64aa7..9363d6d 100644 --- a/R/compile.R +++ b/R/compile.R @@ -14,13 +14,6 @@ ts_compile.ts_function <- function(f, name = deparse(substitute(f)), ...) { sprintf("const %s = R.ocap([%s], %s]);", name, fn_args, result$r_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 ts_compile.character <- function( f, diff --git a/README.Rmd b/README.Rmd index 0d8f6b6..e0725f2 100644 --- a/README.Rmd +++ b/README.Rmd @@ -84,6 +84,13 @@ type App = { }; ``` +Besides generating the schema as shown above, the app object can also be 'deployed' using Rserve: + +```r +ts_deploy(app, port = 6311, daemon = FALSE) +# listening on port 6311 +``` + ## State of the project Here's what's currently working: diff --git a/tests/testthat/test-functions.R b/tests/testthat/test-functions.R index 0bde1cd..369fd80 100644 --- a/tests/testthat/test-functions.R +++ b/tests/testthat/test-functions.R @@ -65,4 +65,8 @@ test_that("function with complex return types", { expect_silent(s$set$call(100:200)) expect_gte(s$get$call(1), 100) + + # you would then 'deploy' this as an App that + # doesn't require the $call methods + # e.g., sampler(1:10)$get(5) }) From 5e84656a89dec1ee5557dd905f22382836b9da5c Mon Sep 17 00:00:00 2001 From: Tom Elliott Date: Mon, 20 Jan 2025 21:13:21 +1300 Subject: [PATCH 10/20] docs --- R/compile.R | 54 +++++++++++++++++++-------------- R/types.R | 50 +++++++++++++++++++++++++++++- README.Rmd | 10 ------ man/ts_character.Rd | 18 +++++++++++ man/ts_compile.Rd | 23 ++++++++++++++ man/ts_dataframe.Rd | 6 ++++ man/ts_factor.Rd | 3 ++ man/ts_integer.Rd | 18 +++++++++++ man/ts_list.Rd | 3 ++ man/ts_logical.Rd | 18 +++++++++++ man/ts_null.Rd | 14 +++++++++ man/ts_numeric.Rd | 18 +++++++++++ man/ts_void.Rd | 15 +++++++++ tests/testthat/app.R | 4 +-- tests/testthat/app.d.ts | 17 ++++++++--- tests/testthat/functions.R | 14 --------- tests/testthat/test-compile.R | 44 +++++++++++++++++++++++++++ tests/testthat/test-functions.R | 4 --- 18 files changed, 276 insertions(+), 57 deletions(-) create mode 100644 man/ts_character.Rd create mode 100644 man/ts_compile.Rd create mode 100644 man/ts_integer.Rd create mode 100644 man/ts_logical.Rd create mode 100644 man/ts_null.Rd create mode 100644 man/ts_numeric.Rd create mode 100644 man/ts_void.Rd delete mode 100644 tests/testthat/functions.R create mode 100644 tests/testthat/test-compile.R diff --git a/R/compile.R b/R/compile.R index 9363d6d..5402dfb 100644 --- a/R/compile.R +++ b/R/compile.R @@ -1,17 +1,27 @@ +#' 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 -ts_compile <- function(f, ..., file = NULL) { +ts_compile <- function(f, ..., name, file) { o <- UseMethod("ts_compile") } #' @export -ts_compile.ts_function <- function(f, name = deparse(substitute(f)), ...) { - inputs <- attr(f, "args") - result <- attr(f, "result") +ts_compile.ts_function <- function(f, ..., name = deparse(substitute(f))) { + inputs <- f$args + result <- f$result - inputs <- sapply(inputs, \(x) x$zod_type) - fn_args <- paste(inputs) |> - paste(collapse = ", ") - sprintf("const %s = R.ocap([%s], %s]);", name, fn_args, result$r_type) + inputs <- sapply(inputs, \(x) x$input_type) + fn_args <- paste(paste(inputs), collapse = ", ") + + sprintf( + "const %s = Robj.ocap([%s], %s);", name, fn_args, + result$return_type + ) } #' @export @@ -32,22 +42,22 @@ ts_compile.character <- function( 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) + # types <- unique( + # gsub( + # "RTYPE\\.(\\w+)", "\\1", + # unlist(regmatches(x, gregexpr("RTYPE\\.\\w+", x))) + # ) + # ) + # x <- gsub("RTYPE\\.", "", x) - cat( - sprintf( - "import { %s } from 'rserve-ts';\n\n", - paste(types, collapse = ", ") - ), - file = file + src <- c( + "import { Robj } from 'rserve-ts';", + "import { z } from 'zod';", + "\n", + x ) - cat(x, sep = "\n", file = file, append = TRUE) + + writeLines(src, file) invisible() } diff --git a/R/types.R b/R/types.R index ddf9182..4485440 100644 --- a/R/types.R +++ b/R/types.R @@ -136,7 +136,15 @@ n_type_fun <- function(n, type) { sprintf("%s(%s)", type, ifelse(n < 0, "", 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 +#' @md ts_logical <- function(n = -1L) { ts_object( n_type(n, "z.boolean()"), @@ -151,10 +159,18 @@ ts_logical <- function(n = -1L) { ) } +#' 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 +#' @md ts_integer <- function(n = -1L) { ts_object( - n_type(n, "z.number()"), + n_type(n, "z.number()", "z.instanceof(Int32Array)"), n_type_fun(n, "Robj.integer"), check = function(x) { if (!is.integer(x)) stop("Expected an integer") @@ -166,7 +182,15 @@ ts_integer <- function(n = -1L) { ) } +#' 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 +#' @md ts_numeric <- function(n = -1L) { ts_object( n_type(n, "z.number()"), @@ -181,7 +205,14 @@ 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 +#' @md ts_character <- function(n = -1L) { ts_object( n_type(n, "z.string()"), @@ -203,6 +234,7 @@ 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!). #' #' @param levels A character vector of levels (optional). +#' @return A ts object that accepts factors with the specified levels. #' #' @export #' @md @@ -236,6 +268,7 @@ ts_factor <- function(levels = NULL) { #' #' 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 #' @md @@ -292,6 +325,9 @@ ts_list <- function(...) { #' #' 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 #' @md ts_dataframe <- function(...) { @@ -323,7 +359,13 @@ ts_dataframe <- function(...) { ) } +#' 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()", @@ -335,7 +377,13 @@ ts_null <- function() { ) } +#' 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()", diff --git a/README.Rmd b/README.Rmd index e0725f2..ce68f40 100644 --- a/README.Rmd +++ b/README.Rmd @@ -107,13 +107,3 @@ 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., `(x: T) => T`) -- [ ] Add support for conditional return types - - e.g., `const sample = (x: T[], n: N) => N extends 1 ? T : T[]` - -- [ ] Function overloads? Perhaps just a wrapper around several function definitions... diff --git a/man/ts_character.Rd b/man/ts_character.Rd new file mode 100644 index 0000000..f18322f --- /dev/null +++ b/man/ts_character.Rd @@ -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())}). +} diff --git a/man/ts_compile.Rd b/man/ts_compile.Rd new file mode 100644 index 0000000..4a00147 --- /dev/null +++ b/man/ts_compile.Rd @@ -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 +} diff --git a/man/ts_dataframe.Rd b/man/ts_dataframe.Rd index 7b5dc44..eef97b1 100644 --- a/man/ts_dataframe.Rd +++ b/man/ts_dataframe.Rd @@ -6,6 +6,12 @@ \usage{ ts_dataframe(...) } +\arguments{ +\item{...}{Named types.} +} +\value{ +A ts object that accepts data frames with the specified types. +} \description{ This is essentially a list, but the elements must have names and are all the same length. } diff --git a/man/ts_factor.Rd b/man/ts_factor.Rd index 1085832..eedbf24 100644 --- a/man/ts_factor.Rd +++ b/man/ts_factor.Rd @@ -9,6 +9,9 @@ ts_factor(levels = NULL) \arguments{ \item{levels}{A character vector of levels (optional).} } +\value{ +A ts object that accepts factors with the specified levels. +} \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!). } diff --git a/man/ts_integer.Rd b/man/ts_integer.Rd new file mode 100644 index 0000000..77a5063 --- /dev/null +++ b/man/ts_integer.Rd @@ -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)}). +} diff --git a/man/ts_list.Rd b/man/ts_list.Rd index dd6cb7a..7bfab76 100644 --- a/man/ts_list.Rd +++ b/man/ts_list.Rd @@ -9,6 +9,9 @@ ts_list(...) \arguments{ \item{...}{A list of types, named or unnamed.} } +\value{ +A ts object that accepts lists with the specified types. +} \description{ A list is a vector of other robjects, which may or may not be named. } diff --git a/man/ts_logical.Rd b/man/ts_logical.Rd new file mode 100644 index 0000000..30e608a --- /dev/null +++ b/man/ts_logical.Rd @@ -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)}). +} diff --git a/man/ts_null.Rd b/man/ts_null.Rd new file mode 100644 index 0000000..26a5f67 --- /dev/null +++ b/man/ts_null.Rd @@ -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}. +} diff --git a/man/ts_numeric.Rd b/man/ts_numeric.Rd new file mode 100644 index 0000000..ab18d85 --- /dev/null +++ b/man/ts_numeric.Rd @@ -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)}). +} diff --git a/man/ts_void.Rd b/man/ts_void.Rd new file mode 100644 index 0000000..6d5d40e --- /dev/null +++ b/man/ts_void.Rd @@ -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). +} diff --git a/tests/testthat/app.R b/tests/testthat/app.R index 3e4fcbf..2e208a8 100644 --- a/tests/testthat/app.R +++ b/tests/testthat/app.R @@ -1,8 +1,8 @@ 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) +fn_first <- ts_function(function(x = ts_character(-1)) x[1], + result = ts_character(1) ) sample_num <- ts_function( diff --git a/tests/testthat/app.d.ts b/tests/testthat/app.d.ts index 3a34907..3a7ec01 100644 --- a/tests/testthat/app.d.ts +++ b/tests/testthat/app.d.ts @@ -1,5 +1,14 @@ -import type { Character, Numeric, PE.Numeric<1>, } from 'rserve-ts'; +import { Robj } from "rserve-ts"; +import { z } from "zod"; -const fn_first = (x: string | string[]) => Promise)>; -const fn_mean = (x: number | number[]) => Promise)>; -c("const sample_one = (x: number | number[]) => Promise)>;", "const sample_one = (x: string | string[]) => Promise)>;") +const fn_first = Robj.ocap( + [z.union([z.string(), Robj.character(0)])], + Robj.character(1) +); + +const fn_mean = Robj.ocap( + [z.union([z.number(), z.instanceof(Float64Array)])], + Robj.numeric(1) +); + +const sample_num = Robj.ocap([z.instanceof(Float64Array)], Robj.numeric(1)); diff --git a/tests/testthat/functions.R b/tests/testthat/functions.R deleted file mode 100644 index f6216c8..0000000 --- a/tests/testthat/functions.R +++ /dev/null @@ -1,14 +0,0 @@ -# overload input/return types - - - - -# ts_compile(d_normal) - -# compile to: -# const sampler = R.ocap( -# [], -# R.list({ -# num: R.ocap([], R.numeric(1)) -# }) -# ); diff --git a/tests/testthat/test-compile.R b/tests/testthat/test-compile.R new file mode 100644 index 0000000..1470bbc --- /dev/null +++ b/tests/testthat/test-compile.R @@ -0,0 +1,44 @@ +test_that("anonomous functions", { + add <- ts_function( + function(a = ts_numeric(1), b = ts_numeric(1)) a + b, + result = ts_numeric(1) + ) + + ts_compile(add) + + # expect_equal(add$call(1, 2), 3) + # expect_error(add$call("a", 2)) +}) + +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()) + ) + ) + + ts_compile(sampler) +}) + +test_that("Compile files", { + on.exit(if (file.exists("app.d.ts")) unlink("app.d.ts")) + res <- ts_compile("app.R") +}) diff --git a/tests/testthat/test-functions.R b/tests/testthat/test-functions.R index 369fd80..0bde1cd 100644 --- a/tests/testthat/test-functions.R +++ b/tests/testthat/test-functions.R @@ -65,8 +65,4 @@ test_that("function with complex return types", { expect_silent(s$set$call(100:200)) expect_gte(s$get$call(1), 100) - - # you would then 'deploy' this as an App that - # doesn't require the $call methods - # e.g., sampler(1:10)$get(5) }) From 600aa1962ae3ebe65937d5beb9f9117e7c5c917b Mon Sep 17 00:00:00 2001 From: Tom Elliott Date: Mon, 20 Jan 2025 21:16:15 +1300 Subject: [PATCH 11/20] update readme --- R/compile.R | 2 +- README.Rmd | 4 ++-- README.md | 44 ++++++++++++++++++++------------------------ 3 files changed, 23 insertions(+), 27 deletions(-) diff --git a/R/compile.R b/R/compile.R index 5402dfb..874eb4f 100644 --- a/R/compile.R +++ b/R/compile.R @@ -57,7 +57,7 @@ ts_compile.character <- function( x ) - writeLines(src, file) + cat(src, file = file, sep = "\n") invisible() } diff --git a/README.Rmd b/README.Rmd index ce68f40..6495465 100644 --- a/README.Rmd +++ b/README.Rmd @@ -99,9 +99,9 @@ Here's what's currently working: library(ts) myfun <- ts_function(mean, x = ts_numeric(), result = ts_numeric(1)) -myfun(1:5) +myfun$call(1:5) -myfun("hello world") +myfun$call("hello world") cat(readLines("tests/testthat/app.R"), sep = "\n") diff --git a/README.md b/README.md index 85f8e8b..b84c7c2 100644 --- a/README.md +++ b/README.md @@ -78,6 +78,14 @@ type App = { }; ``` +Besides generating the schema as shown above, the app object can also be +‘deployed’ using Rserve: + +``` r +ts_deploy(app, port = 6311, daemon = FALSE) +# listening on port 6311 +``` + ## State of the project Here’s what’s currently working: @@ -86,18 +94,18 @@ Here’s what’s currently working: library(ts) myfun <- ts_function(mean, x = ts_numeric(), result = ts_numeric(1)) -myfun(1:5) -#> Error in myfun(1:5): could not find function "myfun" +myfun$call(1:5) +#> [1] 3 -myfun("hello world") -#> Error in myfun("hello world"): could not find function "myfun" +myfun$call("hello world") +#> Error: Invalid argument 'x': 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) +#> fn_first <- ts_function(function(x = ts_character(-1)) x[1], +#> result = ts_character(1) #> ) #> #> sample_num <- ts_function( @@ -107,23 +115,11 @@ cat(readLines("tests/testthat/app.R"), sep = "\n") #> ) ts_compile("tests/testthat/app.R", file = "") -#> import { } from 'rserve-ts'; +#> import { Robj } from 'rserve-ts'; +#> import { z } from 'zod'; #> -#> character(0) -#> character(0) -#> character(0) +#> +#> const fn_first = Robj.ocap([z.union([z.string(), Robj.character(0)])], Robj.character(1)); +#> const fn_mean = Robj.ocap([z.union([z.number(), z.instanceof(Float64Array)])], Robj.numeric(1)); +#> const sample_num = Robj.ocap([z.instanceof(Float64Array)], Robj.numeric(1)); ``` - -## TODO - - - [ ] Add support for more types - - - [ ] Allow generic types (e.g., `(x: T) => T`) - - - [ ] Add support for conditional return types - - e.g., `const sample = (x: T[], n: N) => N - extends 1 ? T : T[]` - - - [ ] Function overloads? Perhaps just a wrapper around several - function definitions… From 620be25588da27016f6a54dad24e1ee421314c7b Mon Sep 17 00:00:00 2001 From: Tom Elliott Date: Mon, 20 Jan 2025 22:17:12 +1300 Subject: [PATCH 12/20] working on deployment methods --- DESCRIPTION | 3 ++- NAMESPACE | 5 +++++ R/function.R | 25 +++++++++++++++++++++++++ 3 files changed, 32 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 05098ce..3da4cb1 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -16,4 +16,5 @@ Config/testthat/edition: 3 Imports: cli, js, - rlang + rlang, + Rserve diff --git a/NAMESPACE b/NAMESPACE index 3eb7ff1..9cfd924 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -8,15 +8,20 @@ S3method(get_type,ts_function) S3method(get_type,ts_object) S3method(print,ts_function) S3method(print,ts_object) +S3method(ts_app,default) +S3method(ts_app,list) +S3method(ts_app,ts_function) S3method(ts_compile,character) S3method(ts_compile,default) S3method(ts_compile,ts_function) export(check_type) export(get_type) export(is_ts_object) +export(ts_app) export(ts_character) export(ts_compile) export(ts_dataframe) +export(ts_deploy) export(ts_factor) export(ts_function) export(ts_integer) diff --git a/R/function.R b/R/function.R index 8dafc57..40d17c4 100644 --- a/R/function.R +++ b/R/function.R @@ -97,3 +97,28 @@ print.ts_function <- function(x, ...) { 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(...))) +} From 722c4de693b86d424754b413a9f89c0f1b87e361 Mon Sep 17 00:00:00 2001 From: Tom Elliott Date: Tue, 21 Jan 2025 13:25:59 +1300 Subject: [PATCH 13/20] get a basic js example working --- R/compile.R | 9 ---- R/deploy.R | 71 +++++++++++++++++++++++++++ man/ts_app.Rd | 16 ++++++ man/ts_deploy.Rd | 33 +++++++++++++ tests/testthat/app.rserve.R | 30 +++++++++++ tests/testthat/sampler/.gitignore | 1 + tests/testthat/sampler/app.js | 25 ++++++++++ tests/testthat/sampler/package.json | 16 ++++++ tests/testthat/sampler/pnpm-lock.yaml | 52 ++++++++++++++++++++ tests/testthat/test_deploy.R | 25 ++++++++++ 10 files changed, 269 insertions(+), 9 deletions(-) create mode 100644 R/deploy.R create mode 100644 man/ts_app.Rd create mode 100644 man/ts_deploy.Rd create mode 100644 tests/testthat/app.rserve.R create mode 100644 tests/testthat/sampler/.gitignore create mode 100644 tests/testthat/sampler/app.js create mode 100644 tests/testthat/sampler/package.json create mode 100644 tests/testthat/sampler/pnpm-lock.yaml create mode 100644 tests/testthat/test_deploy.R diff --git a/R/compile.R b/R/compile.R index 874eb4f..0cbb8f4 100644 --- a/R/compile.R +++ b/R/compile.R @@ -41,15 +41,6 @@ ts_compile.character <- function( 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( "import { Robj } from 'rserve-ts';", "import { z } from 'zod';", diff --git a/R/deploy.R b/R/deploy.R new file mode 100644 index 0000000..7569288 --- /dev/null +++ b/R/deploy.R @@ -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")] +} diff --git a/man/ts_app.Rd b/man/ts_app.Rd new file mode 100644 index 0000000..3cf8c66 --- /dev/null +++ b/man/ts_app.Rd @@ -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()}. +} diff --git a/man/ts_deploy.Rd b/man/ts_deploy.Rd new file mode 100644 index 0000000..49293e5 --- /dev/null +++ b/man/ts_deploy.Rd @@ -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 +} diff --git a/tests/testthat/app.rserve.R b/tests/testthat/app.rserve.R new file mode 100644 index 0000000..602d3f7 --- /dev/null +++ b/tests/testthat/app.rserve.R @@ -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 +) diff --git a/tests/testthat/sampler/.gitignore b/tests/testthat/sampler/.gitignore new file mode 100644 index 0000000..3c3629e --- /dev/null +++ b/tests/testthat/sampler/.gitignore @@ -0,0 +1 @@ +node_modules diff --git a/tests/testthat/sampler/app.js b/tests/testthat/sampler/app.js new file mode 100644 index 0000000..d184429 --- /dev/null +++ b/tests/testthat/sampler/app.js @@ -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(); diff --git a/tests/testthat/sampler/package.json b/tests/testthat/sampler/package.json new file mode 100644 index 0000000..64f079b --- /dev/null +++ b/tests/testthat/sampler/package.json @@ -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" + } +} diff --git a/tests/testthat/sampler/pnpm-lock.yaml b/tests/testthat/sampler/pnpm-lock.yaml new file mode 100644 index 0000000..4c5fc69 --- /dev/null +++ b/tests/testthat/sampler/pnpm-lock.yaml @@ -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: {} diff --git a/tests/testthat/test_deploy.R b/tests/testthat/test_deploy.R new file mode 100644 index 0000000..56ec867 --- /dev/null +++ b/tests/testthat/test_deploy.R @@ -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()) + ) + ) +}) From 6cef29f47f99b5a5895fbd004b7a4c30f88e69f4 Mon Sep 17 00:00:00 2001 From: Tom Elliott Date: Tue, 21 Jan 2025 16:05:47 +1300 Subject: [PATCH 14/20] demo working using typescript; some type issues picked up --- R/compile.R | 8 +- R/types.R | 8 +- tests/testthat/app.R | 5 +- tests/testthat/app.rserve.R | 5 +- tests/testthat/sampler/app.js | 25 --- .../{app.d.ts => sampler/app.schema.ts} | 13 +- tests/testthat/sampler/app.ts | 33 ++++ tests/testthat/sampler/index.js | 0 tests/testthat/sampler/package.json | 7 +- tests/testthat/sampler/pnpm-lock.yaml | 167 ++++++++++++++++++ tests/testthat/sampler/tsconfig.json | 15 ++ 11 files changed, 250 insertions(+), 36 deletions(-) delete mode 100644 tests/testthat/sampler/app.js rename tests/testthat/{app.d.ts => sampler/app.schema.ts} (51%) create mode 100644 tests/testthat/sampler/app.ts create mode 100644 tests/testthat/sampler/index.js create mode 100644 tests/testthat/sampler/tsconfig.json diff --git a/R/compile.R b/R/compile.R index 0cbb8f4..dcc4c02 100644 --- a/R/compile.R +++ b/R/compile.R @@ -45,9 +45,15 @@ ts_compile.character <- function( "import { Robj } from 'rserve-ts';", "import { z } from 'zod';", "\n", - x + x, + "\n", + sprintf("export default {\n %s\n};", paste(ls(e), collapse = ",\n ")) ) + # if (file != "" && file.exists(file)) { + # stop(sprintf("File exists: %s", file)) + # return() + # } cat(src, file = file, sep = "\n") invisible() diff --git a/R/types.R b/R/types.R index 4485440..5bef6c0 100644 --- a/R/types.R +++ b/R/types.R @@ -120,7 +120,7 @@ ts_array <- function(type = c("z.number()", "z.boolean()", "z.string()")) { if (type == "z.boolean()") { return("z.instanceof(Uint8Array)") } - return("Robj.character(0)") + return("z.array(z.string())") } n_type <- function(n, type, pl = ts_array(type)) { @@ -173,7 +173,11 @@ ts_integer <- function(n = -1L) { n_type(n, "z.number()", "z.instanceof(Int32Array)"), n_type_fun(n, "Robj.integer"), check = function(x) { - if (!is.integer(x)) stop("Expected an integer") + if (!is.numeric(x)) stop("Expected a number") + 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) } diff --git a/tests/testthat/app.R b/tests/testthat/app.R index 2e208a8..ebac7d5 100644 --- a/tests/testthat/app.R +++ b/tests/testthat/app.R @@ -1,12 +1,13 @@ 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], +fn_first <- ts_function(function(x = ts_character()) x[1], result = ts_character(1) ) sample_num <- ts_function( sample, x = ts_numeric(0), - result = ts_numeric(1) + size = ts_integer(1), + result = ts_numeric() ) diff --git a/tests/testthat/app.rserve.R b/tests/testthat/app.rserve.R index 602d3f7..3817154 100644 --- a/tests/testthat/app.rserve.R +++ b/tests/testthat/app.rserve.R @@ -4,14 +4,15 @@ 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], +fn_first <- ts_function(function(x = ts_character()) x[1], result = ts_character(1) ) sample_num <- ts_function( sample, x = ts_numeric(0), - result = ts_numeric(1) + size = ts_integer(1), + result = ts_numeric() ) first.fns <- function() ts_app(list( fn_first = fn_first, diff --git a/tests/testthat/sampler/app.js b/tests/testthat/sampler/app.js deleted file mode 100644 index d184429..0000000 --- a/tests/testthat/sampler/app.js +++ /dev/null @@ -1,25 +0,0 @@ -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(); diff --git a/tests/testthat/app.d.ts b/tests/testthat/sampler/app.schema.ts similarity index 51% rename from tests/testthat/app.d.ts rename to tests/testthat/sampler/app.schema.ts index 3a7ec01..7387d09 100644 --- a/tests/testthat/app.d.ts +++ b/tests/testthat/sampler/app.schema.ts @@ -2,13 +2,20 @@ import { Robj } from "rserve-ts"; import { z } from "zod"; const fn_first = Robj.ocap( - [z.union([z.string(), Robj.character(0)])], + [z.union([z.string(), z.array(z.string())])], Robj.character(1) ); - const fn_mean = Robj.ocap( [z.union([z.number(), z.instanceof(Float64Array)])], Robj.numeric(1) ); +const sample_num = Robj.ocap( + [z.instanceof(Float64Array), z.number()], + Robj.numeric() +); -const sample_num = Robj.ocap([z.instanceof(Float64Array)], Robj.numeric(1)); +export default { + fn_first, + fn_mean, + sample_num, +}; diff --git a/tests/testthat/sampler/app.ts b/tests/testthat/sampler/app.ts new file mode 100644 index 0000000..42280ab --- /dev/null +++ b/tests/testthat/sampler/app.ts @@ -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.schema"; + +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(); diff --git a/tests/testthat/sampler/index.js b/tests/testthat/sampler/index.js new file mode 100644 index 0000000..e69de29 diff --git a/tests/testthat/sampler/package.json b/tests/testthat/sampler/package.json index 64f079b..c2a0d57 100644 --- a/tests/testthat/sampler/package.json +++ b/tests/testthat/sampler/package.json @@ -10,7 +10,12 @@ "author": "", "license": "ISC", "dependencies": { + "@types/node": "^22.10.7", + "@types/ws": "^8.5.13", "rserve-ts": "^0.6.1", - "ws": "^8.18.0" + "ts-node": "^10.9.2", + "typescript": "^5.7.3", + "ws": "^8.18.0", + "zod": "^3.24.1" } } diff --git a/tests/testthat/sampler/pnpm-lock.yaml b/tests/testthat/sampler/pnpm-lock.yaml index 4c5fc69..7adf9d8 100644 --- a/tests/testthat/sampler/pnpm-lock.yaml +++ b/tests/testthat/sampler/pnpm-lock.yaml @@ -8,21 +8,115 @@ 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'} @@ -35,18 +129,91 @@ packages: 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: {} diff --git a/tests/testthat/sampler/tsconfig.json b/tests/testthat/sampler/tsconfig.json new file mode 100644 index 0000000..0622f1a --- /dev/null +++ b/tests/testthat/sampler/tsconfig.json @@ -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 + } +} From bf50157ad97565bba0945d2d81599a307e87d38b Mon Sep 17 00:00:00 2001 From: Tom Elliott Date: Tue, 21 Jan 2025 20:40:53 +1300 Subject: [PATCH 15/20] rm generated files --- tests/testthat/app.rserve.R | 31 ---------------------------- tests/testthat/sampler/.gitignore | 1 + tests/testthat/sampler/app.schema.ts | 21 ------------------- 3 files changed, 1 insertion(+), 52 deletions(-) delete mode 100644 tests/testthat/app.rserve.R delete mode 100644 tests/testthat/sampler/app.schema.ts diff --git a/tests/testthat/app.rserve.R b/tests/testthat/app.rserve.R deleted file mode 100644 index 3817154..0000000 --- a/tests/testthat/app.rserve.R +++ /dev/null @@ -1,31 +0,0 @@ -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()) x[1], - result = ts_character(1) -) - -sample_num <- ts_function( - sample, - x = ts_numeric(0), - size = ts_integer(1), - result = ts_numeric() -) -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 -) diff --git a/tests/testthat/sampler/.gitignore b/tests/testthat/sampler/.gitignore index 3c3629e..c8f499a 100644 --- a/tests/testthat/sampler/.gitignore +++ b/tests/testthat/sampler/.gitignore @@ -1 +1,2 @@ node_modules +*.schema.ts diff --git a/tests/testthat/sampler/app.schema.ts b/tests/testthat/sampler/app.schema.ts deleted file mode 100644 index 7387d09..0000000 --- a/tests/testthat/sampler/app.schema.ts +++ /dev/null @@ -1,21 +0,0 @@ -import { Robj } from "rserve-ts"; -import { z } from "zod"; - -const fn_first = Robj.ocap( - [z.union([z.string(), z.array(z.string())])], - Robj.character(1) -); -const fn_mean = Robj.ocap( - [z.union([z.number(), z.instanceof(Float64Array)])], - Robj.numeric(1) -); -const sample_num = Robj.ocap( - [z.instanceof(Float64Array), z.number()], - Robj.numeric() -); - -export default { - fn_first, - fn_mean, - sample_num, -}; From 2866bed187eea53e2912b42733a82b2206fec11f Mon Sep 17 00:00:00 2001 From: Tom Elliott Date: Tue, 21 Jan 2025 20:51:28 +1300 Subject: [PATCH 16/20] minor edits --- R/compile.R | 2 +- tests/testthat/app.R | 2 -- tests/testthat/test-compile.R | 64 ++++++++++++++++++----------------- tests/testthat/test-deploy.R | 5 +++ tests/testthat/test_deploy.R | 25 -------------- 5 files changed, 39 insertions(+), 59 deletions(-) create mode 100644 tests/testthat/test-deploy.R delete mode 100644 tests/testthat/test_deploy.R diff --git a/R/compile.R b/R/compile.R index dcc4c02..2a9aa7e 100644 --- a/R/compile.R +++ b/R/compile.R @@ -27,7 +27,7 @@ ts_compile.ts_function <- function(f, ..., name = deparse(substitute(f))) { #' @export ts_compile.character <- function( 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) { return(sapply(f, ts_compile)) } diff --git a/tests/testthat/app.R b/tests/testthat/app.R index ebac7d5..855ee6b 100644 --- a/tests/testthat/app.R +++ b/tests/testthat/app.R @@ -1,5 +1,3 @@ -library(ts) - fn_mean <- ts_function(mean, x = ts_numeric(), result = ts_numeric(1)) fn_first <- ts_function(function(x = ts_character()) x[1], result = ts_character(1) diff --git a/tests/testthat/test-compile.R b/tests/testthat/test-compile.R index 1470bbc..43db551 100644 --- a/tests/testthat/test-compile.R +++ b/tests/testthat/test-compile.R @@ -4,41 +4,43 @@ test_that("anonomous functions", { result = ts_numeric(1) ) - ts_compile(add) - - # expect_equal(add$call(1, 2), 3) - # expect_error(add$call("a", 2)) + 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() - ) +# 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 <- 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()) +# ) +# ) - ts_compile(sampler) -}) +# sampler_c <- ts_compile(sampler) +# s <- sampler_c(1:10) +# expect_equal() +# }) test_that("Compile files", { - on.exit(if (file.exists("app.d.ts")) unlink("app.d.ts")) - res <- ts_compile("app.R") + f <- tempfile(fileext = ".rserve.ts") + on.exit(unlink(f)) + res <- ts_compile("app.R", file = f) + expect_true(file.exists(f)) }) diff --git a/tests/testthat/test-deploy.R b/tests/testthat/test-deploy.R new file mode 100644 index 0000000..d89ef9b --- /dev/null +++ b/tests/testthat/test-deploy.R @@ -0,0 +1,5 @@ +test_that("Deploy converts ts functions into valid ocap lists", { + on.exit(if (file.exists("app.rserve.R")) unlink("app.rserve.R")) + ts_deploy("app.R") + expect_true(file.exists("app.rserve.R")) +}) diff --git a/tests/testthat/test_deploy.R b/tests/testthat/test_deploy.R deleted file mode 100644 index 56ec867..0000000 --- a/tests/testthat/test_deploy.R +++ /dev/null @@ -1,25 +0,0 @@ -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()) - ) - ) -}) From 38c13b10f6a2b7db13f825d5616430cd4baf1a6d Mon Sep 17 00:00:00 2001 From: Tom Elliott Date: Tue, 21 Jan 2025 20:57:30 +1300 Subject: [PATCH 17/20] organise demo app --- tests/testthat/sampler/.gitignore | 1 + tests/testthat/{ => sampler}/app.R | 0 tests/testthat/test-compile.R | 2 +- tests/testthat/test-deploy.R | 7 ++++--- 4 files changed, 6 insertions(+), 4 deletions(-) rename tests/testthat/{ => sampler}/app.R (100%) diff --git a/tests/testthat/sampler/.gitignore b/tests/testthat/sampler/.gitignore index c8f499a..050e5f1 100644 --- a/tests/testthat/sampler/.gitignore +++ b/tests/testthat/sampler/.gitignore @@ -1,2 +1,3 @@ node_modules +*.rserve.R *.schema.ts diff --git a/tests/testthat/app.R b/tests/testthat/sampler/app.R similarity index 100% rename from tests/testthat/app.R rename to tests/testthat/sampler/app.R diff --git a/tests/testthat/test-compile.R b/tests/testthat/test-compile.R index 43db551..55ea5e3 100644 --- a/tests/testthat/test-compile.R +++ b/tests/testthat/test-compile.R @@ -41,6 +41,6 @@ test_that("anonomous functions", { test_that("Compile files", { f <- tempfile(fileext = ".rserve.ts") on.exit(unlink(f)) - res <- ts_compile("app.R", file = f) + res <- ts_compile("sampler/app.R", file = f) expect_true(file.exists(f)) }) diff --git a/tests/testthat/test-deploy.R b/tests/testthat/test-deploy.R index d89ef9b..ff97728 100644 --- a/tests/testthat/test-deploy.R +++ b/tests/testthat/test-deploy.R @@ -1,5 +1,6 @@ test_that("Deploy converts ts functions into valid ocap lists", { - on.exit(if (file.exists("app.rserve.R")) unlink("app.rserve.R")) - ts_deploy("app.R") - expect_true(file.exists("app.rserve.R")) + f <- tempfile(fileext = ".rserve.R") + on.exit(unlink(f)) + ts_deploy("sampler/app.R", file = f) + expect_true(file.exists(f)) }) From 01424ca5c129e141493ffe73cff550a521b94ab3 Mon Sep 17 00:00:00 2001 From: Tom Elliott Date: Tue, 21 Jan 2025 21:04:11 +1300 Subject: [PATCH 18/20] demo building --- R/deploy.R | 2 ++ tests/testthat/sampler/.gitignore | 3 +-- tests/testthat/sampler/app.R | 2 ++ tests/testthat/sampler/app.ts | 2 +- tests/testthat/sampler/package.json | 4 +++- 5 files changed, 9 insertions(+), 4 deletions(-) diff --git a/R/deploy.R b/R/deploy.R index 7569288..b270512 100644 --- a/R/deploy.R +++ b/R/deploy.R @@ -26,6 +26,8 @@ ts_deploy <- function(f, 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)", diff --git a/tests/testthat/sampler/.gitignore b/tests/testthat/sampler/.gitignore index 050e5f1..f0e445f 100644 --- a/tests/testthat/sampler/.gitignore +++ b/tests/testthat/sampler/.gitignore @@ -1,3 +1,2 @@ node_modules -*.rserve.R -*.schema.ts +app.rserve.* diff --git a/tests/testthat/sampler/app.R b/tests/testthat/sampler/app.R index 855ee6b..ebac7d5 100644 --- a/tests/testthat/sampler/app.R +++ b/tests/testthat/sampler/app.R @@ -1,3 +1,5 @@ +library(ts) + fn_mean <- ts_function(mean, x = ts_numeric(), result = ts_numeric(1)) fn_first <- ts_function(function(x = ts_character()) x[1], result = ts_character(1) diff --git a/tests/testthat/sampler/app.ts b/tests/testthat/sampler/app.ts index 42280ab..12a2864 100644 --- a/tests/testthat/sampler/app.ts +++ b/tests/testthat/sampler/app.ts @@ -10,7 +10,7 @@ interface global { global.WebSocket = WebSocket as any; -import appFuns from "./app.schema"; +import appFuns from "./app.rserve"; async function main() { const con = await RserveClient.create({ diff --git a/tests/testthat/sampler/package.json b/tests/testthat/sampler/package.json index c2a0d57..677ba4a 100644 --- a/tests/testthat/sampler/package.json +++ b/tests/testthat/sampler/package.json @@ -5,7 +5,9 @@ "main": "app.js", "scripts": { "test": "echo \"Error: no test specified\" && exit 1", - "start": "node app.js" + "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", From ce75d4ce7979e9300e6b45b050e9fa63cd4147da Mon Sep 17 00:00:00 2001 From: Tom Elliott Date: Tue, 21 Jan 2025 21:14:42 +1300 Subject: [PATCH 19/20] update readme --- README.Rmd | 68 ++++++++++++++++----------------------- README.md | 93 ++++++++++++++++++------------------------------------ 2 files changed, 57 insertions(+), 104 deletions(-) diff --git a/README.Rmd b/README.Rmd index 6495465..ab8caf5 100644 --- a/README.Rmd +++ b/README.Rmd @@ -33,8 +33,8 @@ devtools::install_github("tmelliott/ts") Writing functions is easy, just use the `ts_*()` functions to define formals and return types. - ```r +# demo.R library(ts) addFn <- ts_function( function(a = ts_numeric(1), b = ts_numeric(1)) a + b, @@ -52,58 +52,44 @@ app <- ts_function( ) }, result = ts_list( - add = appFn, + 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 -import { types as R } from "rserve-ts"; +import { Robj } from 'rserve-ts'; +import { z } from 'zod'; -export const app = { - add: z.function( - z.tuple([z.number(), z.number()]), - z.promise(R.numeric(1)) - ), - sample: z.function( - z.tuple([z.array(z.string()), z.integer()]), - z.promise(R.character()) - ) +const addFn = Robj.ocap([z.number(), z.number()], Robj.numeric(1)); +const app = Robj.ocap([], + Robj.list({ + add: Robj.ocap(), + sample: Robj.ocap() + }) +); +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: -```typescript -type App = { - add: (x: number, y: number) => Promise>; - sample: (x: string[], n: number) => Promise; -}; -``` +You can then import this into your [rserve-ts](https://www.npmjs.com/package/rserve-ts) application. See `tests/testthat/sampler` for an example. -Besides generating the schema as shown above, the app object can also be 'deployed' using Rserve: +It is also possible to generate a sourceable file to deploy an Rserve instance with your app code using `ts_deploy()`: ```r -ts_deploy(app, port = 6311, daemon = FALSE) -# listening on port 6311 -``` - -## 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$call(1:5) - -myfun$call("hello world") - -cat(readLines("tests/testthat/app.R"), sep = "\n") - -ts_compile("tests/testthat/app.R", file = "") +ts_deploy(app) +# run with: Rscript app.rserve.R ``` diff --git a/README.md b/README.md index b84c7c2..e5cf272 100644 --- a/README.md +++ b/README.md @@ -27,6 +27,7 @@ Writing functions is easy, just use the `ts_*()` functions to define formals and return types. ``` r +# demo.R library(ts) addFn <- ts_function( function(a = ts_numeric(1), b = ts_numeric(1)) a + b, @@ -44,82 +45,48 @@ app <- ts_function( ) }, result = ts_list( - add = appFn, + 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 -import { types as R } from "rserve-ts"; +import { Robj } from 'rserve-ts'; +import { z } from 'zod'; -export const app = { - add: z.function( - z.tuple([z.number(), z.number()]), - z.promise(R.numeric(1)) - ), - sample: z.function( - z.tuple([z.array(z.string()), z.integer()]), - z.promise(R.character()) - ) +const addFn = Robj.ocap([z.number(), z.number()], Robj.numeric(1)); +const app = Robj.ocap([], + Robj.list({ + add: Robj.ocap(), + sample: Robj.ocap() + }) +); +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 = { - add: (x: number, y: number) => Promise>; - sample: (x: string[], n: number) => Promise; -}; -``` - -Besides generating the schema as shown above, the app object can also be -‘deployed’ using Rserve: +It is also possible to generate a sourceable file to deploy an Rserve +instance with your app code using `ts_deploy()`: ``` r -ts_deploy(app, port = 6311, daemon = FALSE) -# listening on port 6311 -``` - -## State of the project - -Here’s what’s currently working: - -``` r -library(ts) - -myfun <- ts_function(mean, x = ts_numeric(), result = ts_numeric(1)) -myfun$call(1:5) -#> [1] 3 - -myfun$call("hello world") -#> Error: Invalid argument 'x': 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 = ts_character(-1)) x[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 = "") -#> import { Robj } from 'rserve-ts'; -#> import { z } from 'zod'; -#> -#> -#> const fn_first = Robj.ocap([z.union([z.string(), Robj.character(0)])], Robj.character(1)); -#> const fn_mean = Robj.ocap([z.union([z.number(), z.instanceof(Float64Array)])], Robj.numeric(1)); -#> const sample_num = Robj.ocap([z.instanceof(Float64Array)], Robj.numeric(1)); +ts_deploy(app) +# run with: Rscript app.rserve.R ``` From 1ec847ed5ebd3b28bc1929b011eed190450a6727 Mon Sep 17 00:00:00 2001 From: Tom Elliott Date: Tue, 21 Jan 2025 21:29:16 +1300 Subject: [PATCH 20/20] add readme --- tests/testthat/sampler/README.md | 41 ++++++++++++++++++++++++++++++++ 1 file changed, 41 insertions(+) create mode 100644 tests/testthat/sampler/README.md diff --git a/tests/testthat/sampler/README.md b/tests/testthat/sampler/README.md new file mode 100644 index 0000000..edee7a9 --- /dev/null +++ b/tests/testthat/sampler/README.md @@ -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' ] +```