update types for new api

DESCRIPTION

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

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()"

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,8 +177,8 @@ 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 }",
@@ -173,18 +189,31 @@ ts_list <- function(values = NULL) {
                 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

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.

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

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

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))
+# })