From f54acd6e8a613a0dbed67d2c0b3a3de4672d5925 Mon Sep 17 00:00:00 2001 From: Tom Elliott Date: Mon, 29 Jul 2024 13:37:43 +1200 Subject: [PATCH] compile a file of funtions --- DESCRIPTION | 3 +++ NAMESPACE | 6 +++++ R/compile.R | 53 ++++++++++++++++++++++++++++++++++++--- R/types.R | 8 +++--- README.Rmd | 4 ++- README.md | 15 +++++++++-- man/object.Rd | 25 ++++++++++++++++++ man/ts_dataframe.Rd | 11 ++++++++ man/ts_factor.Rd | 14 +++++++++++ man/ts_list.Rd | 11 ++++++++ tests/testthat.R | 12 +++++++++ tests/testthat/app/app.R | 6 +++++ tests/testthat/app/app.ts | 4 +++ 13 files changed, 162 insertions(+), 10 deletions(-) create mode 100644 man/object.Rd create mode 100644 man/ts_dataframe.Rd create mode 100644 man/ts_factor.Rd create mode 100644 man/ts_list.Rd create mode 100644 tests/testthat.R create mode 100644 tests/testthat/app/app.R create mode 100644 tests/testthat/app/app.ts diff --git a/DESCRIPTION b/DESCRIPTION index 0fd55f5..151766c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -10,3 +10,6 @@ License: MIT + file LICENSE Encoding: UTF-8 Roxygen: list(markdown = TRUE) RoxygenNote: 7.3.1 +Suggests: + testthat (>= 3.0.0) +Config/testthat/edition: 3 diff --git a/NAMESPACE b/NAMESPACE index df530a1..bda2ac1 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,9 +1,15 @@ # Generated by roxygen2: do not edit by hand S3method(print,ts_object) +S3method(ts_compile,character) +S3method(ts_compile,default) +S3method(ts_compile,ts_function) export(ts_character) export(ts_compile) +export(ts_dataframe) +export(ts_factor) export(ts_function) export(ts_integer) +export(ts_list) export(ts_logical) export(ts_numeric) diff --git a/R/compile.R b/R/compile.R index 4c71745..ef8b1c6 100644 --- a/R/compile.R +++ b/R/compile.R @@ -1,11 +1,58 @@ #' @export -ts_compile <- function(f) { - name <- deparse(substitute(f)) +ts_compile <- function(f, file = NULL, ...) { + UseMethod("ts_compile") +} + +#' @export +ts_compile.ts_function <- function(f, file = NULL, name = deparse(substitute(f))) { inputs <- attr(f, "args") result <- attr(f, "result") inputs <- sapply(inputs, \(x) x$type) fn_args <- paste(names(inputs), inputs, sep = ": ") |> paste(collapse = ", ") - cat(sprintf("const %s = (%s) => Promise<%s>;", name, fn_args, result$type_fn), "\n") + sprintf("const %s = (%s) => Promise<%s>;", name, fn_args, result$type_fn) +} + +#' @export +ts_compile.character <- function( + f, + file = sprintf("%s.ts", tools::file_path_sans_ext(f))) { + if (length(f) > 1) { + return(sapply(f, ts_compile)) + } + + if (!file.exists(f)) { + warning(sprintf("File not found: %s", f)) + return() + } + e <- new.env() + source(f, local = e) + + 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) + + cat( + sprintf( + "import type { %s } from 'rserve-ts';\n\n", + paste(types, collapse = ", ") + ), + file = file + ) + cat(x, sep = "\n", file = file, append = TRUE) + + invisible() +} + +#' @export +ts_compile.default <- function(f) { + warning("Not supported") } diff --git a/R/types.R b/R/types.R index 7858897..7c221fc 100644 --- a/R/types.R +++ b/R/types.R @@ -56,7 +56,7 @@ n_type_fun <- function(n, type) { ts_logical <- function(n = -1L) { object( n_type(n, "boolean"), - n_type_fun(n, "Logical"), + n_type_fun(n, "RTYPE.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) @@ -69,7 +69,7 @@ ts_logical <- function(n = -1L) { ts_integer <- function(n = -1L) { object( n_type(n, "number"), - n_type_fun(n, "Integer"), + n_type_fun(n, "RTYPE.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) @@ -82,7 +82,7 @@ ts_integer <- function(n = -1L) { ts_numeric <- function(n = -1L) { object( n_type(n, "number"), - n_type_fun(n, "Numeric"), + n_type_fun(n, "RTYPE.Numeric"), check = function(x) { if (!is.numeric(x)) stop("Expected a number", call. = FALSE) if (n > 0 && length(x) != n) { @@ -97,7 +97,7 @@ ts_numeric <- function(n = -1L) { ts_character <- function(n = -1L) { object( n_type(n, "string"), - n_type_fun(n, "Character"), + n_type_fun(n, "RTYPE.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) diff --git a/README.Rmd b/README.Rmd index 4cbda1d..70dbcbd 100644 --- a/README.Rmd +++ b/README.Rmd @@ -102,5 +102,7 @@ myfun(1:5) myfun("hello world") -ts_compile(myfun) +cat(readLines("tests/testthat/app/app.R"), sep = "\n") + +ts_compile("tests/testthat/app/app.R", file = "") ``` diff --git a/README.md b/README.md index f188a00..14ba64d 100644 --- a/README.md +++ b/README.md @@ -98,6 +98,17 @@ myfun(1:5) myfun("hello world") #> Error: Expected a number -ts_compile(myfun) -#> const myfun = (x: number | number[]) => Promise)>; +cat(readLines("tests/testthat/app/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) +#> ) + +ts_compile("tests/testthat/app/app.R", file = "") +#> import type { Character, Numeric } from 'rserve-ts'; +#> +#> const fn_first = (x: string | string[]) => Promise)>; +#> const fn_mean = (x: number | number[]) => Promise)>; ``` diff --git a/man/object.Rd b/man/object.Rd new file mode 100644 index 0000000..1e98170 --- /dev/null +++ b/man/object.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/types.R +\name{object} +\alias{object} +\title{Typed object} +\usage{ +object( + type = "any", + type_fn = "any", + default = NULL, + check = function() stop("Not implemented") +) +} +\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.} +} +\description{ +This is the base type for all typed objects. It is not meant to be used directly. +} diff --git a/man/ts_dataframe.Rd b/man/ts_dataframe.Rd new file mode 100644 index 0000000..7b5dc44 --- /dev/null +++ b/man/ts_dataframe.Rd @@ -0,0 +1,11 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/types.R +\name{ts_dataframe} +\alias{ts_dataframe} +\title{Typed dataframe} +\usage{ +ts_dataframe(...) +} +\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 new file mode 100644 index 0000000..1085832 --- /dev/null +++ b/man/ts_factor.Rd @@ -0,0 +1,14 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/types.R +\name{ts_factor} +\alias{ts_factor} +\title{Typed factor} +\usage{ +ts_factor(levels = NULL) +} +\arguments{ +\item{levels}{A character vector of levels (optional).} +} +\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_list.Rd b/man/ts_list.Rd new file mode 100644 index 0000000..c8e708d --- /dev/null +++ b/man/ts_list.Rd @@ -0,0 +1,11 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/types.R +\name{ts_list} +\alias{ts_list} +\title{Typed list} +\usage{ +ts_list(values = NULL) +} +\description{ +A list is a vector of other robjects, which may or may not be named. +} diff --git a/tests/testthat.R b/tests/testthat.R new file mode 100644 index 0000000..8e7ee01 --- /dev/null +++ b/tests/testthat.R @@ -0,0 +1,12 @@ +# This file is part of the standard setup for testthat. +# It is recommended that you do not modify it. +# +# Where should you do additional test configuration? +# Learn more about the roles of various files in: +# * https://r-pkgs.org/testing-design.html#sec-tests-files-overview +# * https://testthat.r-lib.org/articles/special-files.html + +library(testthat) +library(ts) + +test_check("ts") diff --git a/tests/testthat/app/app.R b/tests/testthat/app/app.R new file mode 100644 index 0000000..08143b4 --- /dev/null +++ b/tests/testthat/app/app.R @@ -0,0 +1,6 @@ +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) +) diff --git a/tests/testthat/app/app.ts b/tests/testthat/app/app.ts new file mode 100644 index 0000000..8155de3 --- /dev/null +++ b/tests/testthat/app/app.ts @@ -0,0 +1,4 @@ +import { types } from 'rserve-ts'; + +const fn_first = (x: string | string[]) => Promise)>; +const fn_mean = (x: number | number[]) => Promise)>;