some tests; working on fn api

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

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)
+        types <- sapply(values, function(x) x$zod_type)
-        type_funs <- sapply(values, function(x) x$type_fn)
+        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

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) {
+    function(x = ts_number(1), y = ts_number(1)) a + b,
-      x + y
+    ts_numeric(1)
-    },
-    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) {