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