61 Create list2rules

NAMESPACE

@@ -21,6 +21,7 @@ export(h_as_factor)
 export(h_ws_to_explicit_na)
 export(h_ws_to_na)
 export(join_adsub_adsl)
+export(list2rules)
 export(mini_pivot_wider)
 export(multi_pivot_wider)
 export(poly_pivot_wider)

R/rules.R

@@ -37,6 +37,24 @@ print.rule <- function(x, ...) {
   }
 }
 
+#' Read yaml File describing `rule`
+#' @param obj (`nested list`) to convert into list of rules.
+#' @export
+#' @examples
+#' obj <- list(
+#'   rule1 = list("X" = c("a", "b"), "Z" = "c"),
+#'   rule2 = list(Missing = c(NA, ""))
+#' )
+#' list2rules(obj)
+#'
+list2rules <- function(obj) {
+  coll <- checkmate::makeAssertCollection()
+  checkmate::assert_list(obj, unique = TRUE, types = "list", add = coll)
+  checkmate::assert_names(names(obj), type = "unique", add = coll)
+  checkmate::reportAssertions(coll)
+
+  lapply(obj, function(x) rule(.lst = x))
+}
 
 #' Convert Rule to List
 #' @param x (`rule`) to convert.
@@ -67,5 +85,5 @@ print.empty_rule <- function(x, ...) {
 read_rules <- function(file) {
   checkmate::assert_file_exists(file)
   content <- yaml::read_yaml(file)
-  lapply(content, function(x) rule(.lst = x))
+  list2rules(content)
 }

_pkgdown.yaml

@@ -37,6 +37,7 @@ reference:
       - rule
       - as.list.rule
       - empty_rule
+      - list2rules
       - read_rules
   - title: Assertions
     contents:

tests/testthat/test-rules.R

@@ -55,6 +55,43 @@ test_that("emtpy_rule printed correctly", {
   expect_snapshot(empty_rule)
 })
 
+# list2rules ----
+
+test_that("list2rules works as expected", {
+  r1 <- list(
+    rule_a = list(a = 1, b = 2),
+    rule_b = list(a = 3, b = 4),
+    rule_c = list()
+  )
+
+  expect_silent(res <- list2rules(r1))
+
+  checkmate::expect_list(res, type = "rule", len = 3)
+  expect_identical(names(res), c("rule_a", "rule_b", "rule_c"))
+})
+
+test_that("list2rules fails as expected", {
+  r1 <- list(
+    rule_a = list(a = 1, b = 2),
+    rule_b = list(a = 3, b = 4),
+    rule_a_again = list(a = 1, b = 2),
+    rule_b = list("X" = "x")
+  )
+
+  res <- expect_error(capture_output_lines(list2rules(r1), width = 200, print = FALSE))
+
+  expect_match(
+    res$message,
+    "* Variable 'obj': Contains duplicated values, position 3.",
+    fixed = TRUE
+  )
+  expect_match(
+    res$message,
+    "* Variable 'names(obj)': Must have unique names, but element 4 is duplicated.",
+    fixed = TRUE
+  )
+})
+
 # rule reading ----
 
 test_that("list of rules are read correctly", {