Merge pull request #7 from rossellhayes/feat/list-return-values

Support list return values

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: incase
 Title: Pipe-Friendly Vector Replacement with Case Statements
-Version: 0.3.2
+Version: 0.3.2.9000
 Authors@R: c(
     person("Alexander", "Rossell Hayes", , "alexander@rossellhayes.com", role = c("aut", "cre", "cph"),
            comment = c(ORCID = "0000-0001-9412-0457")),

NEWS.md

@@ -1,3 +1,8 @@
+# incase (development version)
+
+* `*_case()` functions can now use lists as return values.
+* `*_case()` functions no longer perform automatic type conversion on non-atomic return values.
+
 # incase 0.3.2
 
 * Accept named arguments with or without preceding dots, e.g. `default` or `.default` (#5).

R/replace.R

@@ -1,10 +1,17 @@
 #' @importFrom rlang %||%
 
 replace <- function(
-  fs, x, default, preserve,
-  fn = NULL, args = NULL,
-  factor = FALSE, ordered = FALSE, list = FALSE,
-  default_env, current_env
+  fs,
+  x,
+  default,
+  preserve,
+  fn = NULL,
+  args = NULL,
+  factor = FALSE,
+  ordered = FALSE,
+  list = FALSE,
+  default_env,
+  current_env
 ) {
   assert_length(fs, call = current_env)
 
@@ -39,7 +46,7 @@ replace <- function(
   out      <- rep_len(default, n)
   replaced <- rep(FALSE, n)
 
-  if (!list) {
+  if (!list & all(vapply(pairs$value, is.atomic, logical(1)))) {
     class       <- class(c(pairs$value, default, recursive = TRUE))
     pairs$value <- lapply(pairs$value, `class<-`, class)
     class(out)  <- class

tests/testthat/test-in_case.R

@@ -28,7 +28,7 @@ test_that("fizz_buzz", {
       in_case(
         . %% 3 == 0 ~ "fizz",
         . %% 5 == 0 ~ "buzz",
-        preserve    = TRUE
+        preserve = TRUE
       ),
     y
   )
@@ -37,12 +37,55 @@ test_that("fizz_buzz", {
     in_case(
       x %% 3 == 0 ~ "fizz",
       x %% 5 == 0 ~ "buzz",
-      default     = "pass"
+      default = "pass"
     ),
     c("pass", "pass", "fizz", "pass", "buzz")
   )
 })
 
+test_that("class coercion of return values", {
+  expect_equal(
+    in_case(
+      x == 1 ~ TRUE,
+      x == 2 ~ 2L,
+      x == 3 ~ 3,
+      x == 4 ~ as.raw(4),
+      x == 5 ~ "five"
+    ),
+    c("TRUE", "2", "3", "04", "five")
+  )
+})
+
+test_that("return list of tibbles", {
+  df1 <- data.frame(x = 1, y = 1)
+  df2 <- data.frame(x = 2, y = 2)
+
+  expect_equal(
+    in_case(
+      x > 3 ~ list(df1),
+      x <= 3 ~ list(df2)
+    ),
+    list(df2, df2, df2, df1, df1)
+  )
+
+  expect_equal(
+    in_case(
+      x > 3 ~ list(df1),
+      default = list(df2)
+    ),
+    list(df2, df2, df2, df1, df1)
+  )
+
+  expect_equal(
+    in_case(
+      x,
+      x > 3 ~ list(df1),
+      preserve = TRUE
+    ),
+    list(1, 2, 3, df1, df1)
+  )
+})
+
 test_that("zero-length input", {
   expect_equal(
     in_case(logical() ~ integer(), default = character(1)),