From 16ed412cd75d586d1be38bd1bbd52be0795eef95 Mon Sep 17 00:00:00 2001 From: Tom Elliott Date: Wed, 8 Jan 2025 16:02:59 +1300 Subject: [PATCH] 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)) +# })