From fca9b5600dd5251ae6ce2eff2de56e453d2d7201 Mon Sep 17 00:00:00 2001 From: Stefan Kuethe Date: Thu, 11 Jan 2024 10:12:21 +0100 Subject: [PATCH 1/6] Rdantic --- R/utils.R | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/R/utils.R b/R/utils.R index e5a170f..985a342 100644 --- a/R/utils.R +++ b/R/utils.R @@ -2,3 +2,18 @@ set_maplibre_class <- function(.obj, class_name) { class(.obj) <- c(class(.obj), class_name) return(.obj) } + +rdantic <- function(.obj, types, test = 1L) { + for (i in 1:length(.obj)) { + # print(.obj[[i]]) + # print(types[[i]]) + type_check <- types[[i]] + value <- .obj[[i]] + # stopifnot(type_check(value)) + if (!type_check(value)) { + stop(value, " is not ", deparse(substitute(type_check)) , call.=FALSE) + } + } + + return(.obj) +} From bc74f0a29fa823a6aec29e163ad1937a716f23dc Mon Sep 17 00:00:00 2001 From: Stefan Kuethe Date: Thu, 11 Jan 2024 10:15:18 +0100 Subject: [PATCH 2/6] Add test for rdantic --- tests/testthat/test-rdantic.R | 12 ++++++++++++ 1 file changed, 12 insertions(+) create mode 100644 tests/testthat/test-rdantic.R diff --git a/tests/testthat/test-rdantic.R b/tests/testthat/test-rdantic.R new file mode 100644 index 0000000..3df236a --- /dev/null +++ b/tests/testthat/test-rdantic.R @@ -0,0 +1,12 @@ +test_that("rdantic", { + # Prepare + l <- list(a = 1, b = "test") + types <- list(is.numeric, is.character) + + # Act + l <- rdantic(l, types) + + # Assert + expect_equal(l$a, 1) + expect_equal(l$b, "test") +}) From 44924107873751049faab7de44afebddcf46f126 Mon Sep 17 00:00:00 2001 From: Stefan Kuethe Date: Thu, 11 Jan 2024 10:23:06 +0100 Subject: [PATCH 3/6] Allow NULL --- R/utils.R | 2 +- tests/testthat/test-rdantic.R | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/R/utils.R b/R/utils.R index 985a342..9d163f9 100644 --- a/R/utils.R +++ b/R/utils.R @@ -10,7 +10,7 @@ rdantic <- function(.obj, types, test = 1L) { type_check <- types[[i]] value <- .obj[[i]] # stopifnot(type_check(value)) - if (!type_check(value)) { + if (xor(!type_check(value), is.null(value))) { stop(value, " is not ", deparse(substitute(type_check)) , call.=FALSE) } } diff --git a/tests/testthat/test-rdantic.R b/tests/testthat/test-rdantic.R index 3df236a..b018d4d 100644 --- a/tests/testthat/test-rdantic.R +++ b/tests/testthat/test-rdantic.R @@ -1,7 +1,7 @@ test_that("rdantic", { # Prepare - l <- list(a = 1, b = "test") - types <- list(is.numeric, is.character) + l <- list(a = 1, b = "test", d = NULL) + types <- list(is.numeric, is.character, is.numeric) # Act l <- rdantic(l, types) From 886db733f8f78d704c29f8087b1c73db1832877c Mon Sep 17 00:00:00 2001 From: Stefan Kuethe Date: Thu, 11 Jan 2024 10:23:56 +0100 Subject: [PATCH 4/6] Remove dead code --- R/utils.R | 3 --- 1 file changed, 3 deletions(-) diff --git a/R/utils.R b/R/utils.R index 9d163f9..82b2a96 100644 --- a/R/utils.R +++ b/R/utils.R @@ -5,11 +5,8 @@ set_maplibre_class <- function(.obj, class_name) { rdantic <- function(.obj, types, test = 1L) { for (i in 1:length(.obj)) { - # print(.obj[[i]]) - # print(types[[i]]) type_check <- types[[i]] value <- .obj[[i]] - # stopifnot(type_check(value)) if (xor(!type_check(value), is.null(value))) { stop(value, " is not ", deparse(substitute(type_check)) , call.=FALSE) } From c7d278e173100c4ee804770c5d49b66494824d57 Mon Sep 17 00:00:00 2001 From: Stefan Kuethe Date: Thu, 11 Jan 2024 10:40:26 +0100 Subject: [PATCH 5/6] Add type check --- R/layer.R | 21 ++++++++++++--------- tests/testthat/test-rdantic.R | 2 +- 2 files changed, 13 insertions(+), 10 deletions(-) diff --git a/R/layer.R b/R/layer.R index c214b08..15afede 100644 --- a/R/layer.R +++ b/R/layer.R @@ -10,13 +10,16 @@ #' #' @export Layer <- function(type, id, source = NULL, paint = NULL, layout = NULL, ...) { - list( - type = type, - id = id, - source = source, - paint = paint, - layout = layout - ) |> + types <- list(type = is.character, id = is.character, source = is.list, paint = is.list, layout = is.list) + c(rdantic( + list( + type = type, + id = id, + source = source, + paint = paint, + layout = layout + ), types + ), ...) |> purrr::compact() |> set_maplibre_class("MapLibreLayer") } @@ -44,7 +47,7 @@ add_layer <- function(.map, layer) { #' @export #' #' @example examples/layers.R -add_popup <- function(.map, layer_id, prop){ +add_popup <- function(.map, layer_id, prop) { .map |> add_call("addPopup", layer_id, prop) } @@ -60,6 +63,6 @@ add_popup <- function(.map, layer_id, prop){ #' #' @examples #' @example examples/layers.R -add_tooltip <- function(.map, layer_id, prop){ +add_tooltip <- function(.map, layer_id, prop) { .map |> add_call("addTooltip", layer_id, prop) } diff --git a/tests/testthat/test-rdantic.R b/tests/testthat/test-rdantic.R index b018d4d..0ed6226 100644 --- a/tests/testthat/test-rdantic.R +++ b/tests/testthat/test-rdantic.R @@ -1,7 +1,7 @@ test_that("rdantic", { # Prepare l <- list(a = 1, b = "test", d = NULL) - types <- list(is.numeric, is.character, is.numeric) + types <- list(a = is.numeric, b = is.character, d = is.numeric) # Act l <- rdantic(l, types) From 1f443cae9c7e9282bc2e835f92925f628a4d5c85 Mon Sep 17 00:00:00 2001 From: Stefan Kuethe Date: Thu, 11 Jan 2024 10:41:27 +0100 Subject: [PATCH 6/6] Refactor --- R/utils.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/utils.R b/R/utils.R index 82b2a96..e6e9f13 100644 --- a/R/utils.R +++ b/R/utils.R @@ -4,9 +4,9 @@ set_maplibre_class <- function(.obj, class_name) { } rdantic <- function(.obj, types, test = 1L) { - for (i in 1:length(.obj)) { - type_check <- types[[i]] - value <- .obj[[i]] + for (k in names(.obj)) { + type_check <- types[[k]] + value <- .obj[[k]] if (xor(!type_check(value), is.null(value))) { stop(value, " is not ", deparse(substitute(type_check)) , call.=FALSE) }