Merge pull request #5 from eodaGmbH/feature/validate-fn

Add funct to validate func

Author: crazycapivara

DESCRIPTION

@@ -2,11 +2,17 @@ Package: rdantic
 Type: Package
 Title: Type Safety for R
 Version: 0.1.0
+Date: 2024-10-13
 Authors@R: c(
-    person("Stefan", "Kuethe", email = "crazycapivara@gmail.com", role = c("aut", "cre", "cph"))
+    person("Stefan", "Kuethe", email = "crazycapivara@gmail.com", role = c("aut", "cre", "cph")),
+    person("Nico", "Friess", email = "nico.friess@eoda.de", role = "aut")
   )
 Maintainer: Stefan Kuethe <crazycapivara@gmail.com>
 Description: Adds type safety to R.
+URL:
+  https://github.com/eodaGmbH/rdantic
+  https://eodagmbh.github.io/rdantic/
+BugReports: https://github.com/eodaGmbH/rdantic/issues
 License: MIT + file LICENSE
 Encoding: UTF-8
 LazyData: true

NAMESPACE

@@ -8,3 +8,4 @@ export(keys_to_camel_case)
 export(keys_to_snake_case)
 export(model_dump)
 export(validate_args)
+export(validate_fn)

NEWS.md

@@ -0,0 +1,3 @@
+# rdantic 0.1.0
+
+* Add NEWS.md to track changes.

R/base-model.R

@@ -23,6 +23,8 @@ validate_model_values <- function(.obj, validators) {
   return(.obj)
 }
 
+# TODO: Rename types to fields
+# TODO: Can/Should we rename '.obj' to 'obj'?
 check_types <- function(types, validators_before = NULL, validators_after = NULL) {
   function(.obj = list(), ..., .drop_null = FALSE, .force_list = FALSE) {
 
@@ -33,6 +35,7 @@ check_types <- function(types, validators_before = NULL, validators_after = NULL
       .obj <- utils::modifyList(.obj, list(...), keep.null = TRUE)
     }
 
+    # TODO: Remove
     if (length(.obj) == 0) .obj <- rlang::caller_env()
 
     if (!is.null(validators_before)) {
@@ -42,9 +45,11 @@ check_types <- function(types, validators_before = NULL, validators_after = NULL
     # for (k in names(.obj)) {
     for (k in names(types)) {
       if (!is.environment(.obj) & !k %in% names(.obj)) {
+        # TODO: Do we really want this?
         .obj[k] <- list(NULL)
       }
 
+      # TODO: Rename to 'fn_type_check'
       type_check <- rlang::as_function(types[[k]])
       value <- .obj[[k]]
       if (!type_check(value)) {
@@ -105,6 +110,27 @@ model_dump <- function(.obj,
   return(.obj)
 }
 
+# ---
+#' Validate function arguments
+#' @inherit base_model params return
+#' @export
+validate_args <- function(..., .validators_before = NULL, .validators_after = NULL) {
+  base_model(
+    ...,
+    .validators_before = .validators_before,
+    .validators_after = .validators_after
+  )(rlang::caller_env())
+}
+
+# ---
+#' Validate function parameters
+#' @param fn function containing the arguments to be checked
+#' @export
+validate_fn <- function(fn) {
+  fmls<- rlang::fn_fmls(fn)
+  fields <- purrr::map(as.list(fmls), eval)
+  purrr::exec(base_model, !!!fields)(rlang::caller_env())
+}
 
 # model_dump_json <- function(.obj, ...) {
 #  model_dump(.obj, ...) |>

R/types.R

@@ -17,15 +17,3 @@ is_optional2 <- function(.f) set_attributes(.f, optional = TRUE)
 is_another_model <- function(.model) {
   function(x) is.list(.model(x))
 }
-
-# ---
-#' Validate function arguments
-#' @inherit base_model params return
-#' @export
-validate_args <- function(..., .validators_before = NULL, .validators_after = NULL) {
-  base_model(
-    ...,
-    .validators_before = .validators_before,
-    .validators_after = .validators_after
-  )(rlang::caller_env())
-}

man/validate_args.Rd

@@ -11,6 +11,7 @@ test_that("lists", {
 
   # Assert
   expect_equal(l, list(a = 10.5, b = 20L, txt = "Hi"))
+  # expect_equal(names(l), c("a", "b", "txt"))
 })
 
 test_that("validators before", {
@@ -47,3 +48,17 @@ test_that("validate func args", {
   # Assert
   expect_equal(res, 6L)
 })
+
+test_that("validate func", {
+  # Prepare
+  f_with_typed_args <- function(a = is.integer, b = is.integer) {
+    validate_fn(f_with_typed_args)
+    a + b
+  }
+
+  # Act
+  res <- f_with_typed_args(2L, 5L)
+
+  # Assert
+  expect_equal(res, 7L)
+})

man/validate_fn.Rd

@@ -22,59 +22,59 @@ library(rlang)
 ## Models
 
 ```{r}
-person <- base_model(
+person_model <- base_model(
   name = is_scalar_character,
   age = is_scalar_integer
 )
 
-person(
+person_model(
   name = "Lee",
   age = 100L
 )
 
-try(person(name = "Lee", age = 100))
+try(person_model(name = "Lee", age = 100))
 
 # It is also possible to pass lists:
-response_from_rest_api <- list(name = "Morgan", age = 100L)
+external_data <- list(name = "Morgan", age = 100L)
 
-response_from_rest_api |> person()
+person_model(external_data)
 ```
 
 ## Validators
 
 ```{r}
-person <- base_model(
+person_model <- base_model(
   name = is_scalar_character,
   age = is_scalar_integer,
   .validators_before = list(
     age = as.integer
   )
 )
 
-person(name = "Lee", age = 100)
+person_model(name = "Lee", age = 100)
 ```
 
 ## Models inside models
 
 ```{r}
-address <- base_model(
+address_model <- base_model(
   city = is_scalar_character,
   country = is_scalar_character
 )
 
-person <- base_model(
+person_model <- base_model(
   name = is_scalar_character,
   age = is_scalar_integer,
-  address = is_another_model(address)
+  address = is_another_model(address_model)
 )
 
-person(
+person_model(
   name = "Peter",
   age = 12L,
-  address = address(city = "Kassel", country = "Germany")
+  address = address_model(city = "Kassel", country = "Germany")
 )
 
-response_from_rest_api <- list(
+external_data <- list(
   statusCode = 200L,
   data = list(
     value = 10,
@@ -95,7 +95,7 @@ api_model <- base_model(
   data = is_another_model(data_model)
 )
 
-response_from_rest_api |>
+external_data |>
   keys_to_snake_case() |>
   api_model()
 ```
@@ -111,6 +111,21 @@ add_two_numbers(10, 20)
 
 try(add_two_numbers(10, c(20, 30)))
 ```
+
+It also possible to add the type checks in this way:
+
+```{r}
+add_two_numbers <- function(a = is_scalar_integer, 
+                            b = is_scalar_integer) {
+  validate_fn(add_two_numbers)
+  a + b
+}
+
+add_two_numbers(1L, 3L)
+
+try(add_two_numbers(1L, 4.6))
+```
+
 ## Settings
 
 ```{r}