Standardise list_modify() (#918)

* `NULL` now sets value
* Don't recurse into non-lists

Fixes #810

NEWS.md

@@ -38,6 +38,11 @@
 
 ## Features and fixes
 
+* `list_modify()`'s interface has been standardised. Modifying with `NULL`
+  now always creates a `NULL` in the output and we no longer recurse into
+  data frames (and other objects built on top of lists that are fundamentally
+  non-list like) (#810).
+
 * `modify_if(.else)` is now actually evaluated for atomic vectors (@mgirlich, 
   #701).
 

R/list-modify.R

@@ -10,10 +10,10 @@
 #'
 #'   These values should be either all named or all unnamed. When
 #'   inputs are all named, they are matched to `.x` by name. When they
-#'   are all unnamed, they are matched positionally.
+#'   are all unnamed, they are matched by position.
 #'
-#'   [Dynamic dots][rlang::dyn-dots] are supported. In particular, if
-#'   your functions are stored in a list, you can splice that in with
+#'   [Dynamic dots][rlang::dyn-dots] are supported. In particular, if your
+#'   replacement values are stored in a list, you can splice that in with
 #'   `!!!`.
 #' @export
 #' @examples
@@ -25,6 +25,7 @@
 #' # Replace values
 #' str(list_modify(x, z = 5))
 #' str(list_modify(x, z = list(a = 1:5)))
+#' str(list_modify(x, z = NULL))
 #'
 #' # Remove values
 #' str(list_modify(x, z = zap()))
@@ -37,72 +38,41 @@
 #' l <- list(new = 1, y = zap(), z = 5)
 #' str(list_modify(x, !!!l))
 list_modify <- function(.x, ...) {
-  list_recurse(.x, list2(...), function(x, y) y)
+  vec_check_list(.x)
+  y <- dots_list(..., .named = NULL, .homonyms = "error")
+  list_recurse(.x, y, function(x, y) y)
 }
 #' @export
 #' @rdname list_modify
 list_merge <- function(.x, ...) {
-  list_recurse(.x, list2(...), c)
+  vec_check_list(.x)
+  y <- dots_list(..., .named = NULL, .homonyms = "error")
+  list_recurse(.x, y, c)
 }
 
-list_recurse <- function(x, y, base_case) {
-  stopifnot(is.list(x), is.list(y))
-
-  if (is_empty(x)) {
-    return(y)
-  }
-  if (is_empty(y)) {
-    return(x)
-  }
-
-  y_names <- names(y)
-  if (!is_null(y_names) && !is_named(y)) {
+list_recurse <- function(x, y, base_f) {
+  if (!is_null(names(y)) && !is_named(y)) {
     abort("`...` arguments must be either all named, or all unnamed")
   }
 
-  # N.B. is_list(zap()) is TRUE.
-  if (is_null(y_names)) {
-    for (i in rev(seq_along(y))) {
-      if (i <= length(x) && is_list(x[[i]]) && is_list(y[[i]]) && !is_zap(y[[i]])) {
-        x[[i]] <- list_recurse(x[[i]], y[[i]], base_case)
-      } else {
-        x[[i]] <- maybe_zap(base_case(x[[i]], y[[i]]))
-      }
-    }
-  } else {
-    for (i in seq_along(y_names)) {
-      nm <- y_names[[i]]
-      if (has_name(x, nm) && is_list(x[[nm]]) && is_list(y[[i]]) && !is_zap(y[[i]])) {
-        x[[nm]] <- list_recurse(x[[nm]], y[[i]], base_case)
-      } else {
-        x[[nm]] <- maybe_zap(base_case(x[[nm]], y[[i]]))
-      }
-    }
-  }
+  idx <- names(y) %||% rev(seq_along(y))
 
-  x
-}
+  for (i in idx) {
+    x_i <- pluck(x, i)
+    y_i <- pluck(y, i)
 
-maybe_zap <- function(x) {
-  if (is_zap(x)) {
-    return(NULL)
-  }
-  if (!is_null(x)) {
-    return(x)
+    if (is_zap(y_i)) {
+      x[[i]] <- NULL
+    } else if (vec_is_list(x_i) && vec_is_list(y_i)) {
+      list_slice2(x, i) <- list_recurse(x_i, y_i, base_f)
+    } else {
+      list_slice2(x, i) <- base_f(x_i, y_i)
+    }
   }
 
-  lifecycle::deprecate_warn(
-    when = "0.3.0",
-    what = I("Removing elements with `NULL`"),
-    with = "zap()"
-  )
-  # Allow removing with `NULL` for now. In purrr 0.5.0, this
-  # functionality will be defunct and we'll allow setting elements to
-  # `NULL`.
-  NULL
+  x
 }
 
-
 #' Update a list with formulas
 #'
 #' @description

tests/testthat/_snaps/list-modify.md

@@ -0,0 +1,50 @@
+# list_modify() validates inputs
+
+    Code
+      list_modify(1:3)
+    Condition
+      Error in `list_modify()`:
+      ! `.x` must be a list, not an integer vector.
+
+---
+
+    Code
+      list_modify(list(a = 1), 2, a = 2)
+    Condition
+      Error in `list_recurse()`:
+      ! `...` arguments must be either all named, or all unnamed
+
+---
+
+    Code
+      list_modify(list(x = 1), x = 2, x = 3)
+    Condition
+      Error in `list_modify()`:
+      ! Arguments in `...` must have unique names.
+      x Multiple arguments named `x` at positions 1 and 2.
+
+# merge() validates inputs
+
+    Code
+      list_merge(1:3)
+    Condition
+      Error in `list_merge()`:
+      ! `.x` must be a list, not an integer vector.
+
+---
+
+    Code
+      list_merge(list(x = 1), x = 2, x = 3)
+    Condition
+      Error in `list_merge()`:
+      ! Arguments in `...` must have unique names.
+      x Multiple arguments named `x` at positions 1 and 2.
+
+# update_list() is deprecated
+
+    Code
+      . <- update_list(list())
+    Condition
+      Warning:
+      `update_list()` was deprecated in purrr 0.4.0.
+

tests/testthat/test-list-modify-update.R → tests/testthat/test-list-modify.R

@@ -3,45 +3,37 @@
 test_that("named lists have values replaced by name", {
   expect_equal(list_modify(list(a = 1), b = 2), list(a = 1, b = 2))
   expect_equal(list_modify(list(a = 1), a = 2), list(a = 2))
+  expect_equal(list_modify(list(a = 1), a = NULL), list(a = NULL))
   expect_equal(list_modify(list(a = 1, b = 2), b = zap()), list(a = 1))
 })
 
 test_that("unnamed lists are replaced by position", {
   expect_equal(list_modify(list(3), 1, 2), list(1, 2))
-  expect_equal(list_modify(list(1, 2, 3), 4), list(4, 2, 3))
-})
+  expect_equal(list_modify(list(3), NULL), list(NULL))
 
-test_that("can remove elements with `zap()`", {
-  expect_equal(list_modify(list(1, 2, 3), zap(), zap()), list(3))
-  expect_equal(list_modify(list(a = 1, b = 2, c = 3), b = zap(), a = zap()), list(c = 3))
-  expect_equal(
-    list_modify(list(a = list(fst = 1, snd = 2), b = 2, c = 3), b = zap(), a = zap()),
-    list(c = 3)
-  )
-  expect_equal(list_modify(list(list(1, 2), 2, 3), zap(), zap()), list(3))
-})
+  expect_equal(list_modify(list(3), zap()), list())
+  expect_equal(list_modify(list(3), zap(), zap()), list())
 
-test_that("error if inputs are not all named or unnamed", {
-  expect_error(
-    list_modify(list(a = 1), 2, a = 2),
-    "must be either all named, or all unnamed"
-  )
+  expect_equal(list_modify(list(1, 2, 3), 4), list(4, 2, 3))
 })
 
 test_that("can update unnamed lists with named inputs", {
   expect_identical(list_modify(list(1), a = 2), list(1, a = 2))
+  expect_identical(list_modify(list(1), a = NULL), list(1, a = NULL))
+  expect_identical(list_modify(list(1), a = zap()), list(1))
 })
 
 test_that("can update named lists with unnamed inputs", {
   expect_identical(list_modify(list(a = 1, b = 2), 2), list(a = 2, b = 2))
+  expect_identical(list_modify(list(a = 1, b = 2), zap()), list(b = 2))
   expect_identical(list_modify(list(a = 1, b = 2), 2, 3, 4), list(a = 2, b = 3, 4))
 })
 
 test_that("lists are replaced recursively", {
   expect_equal(
     list_modify(
       list(a = list(x = 1)),
-      a = list(x = 2)
+      a = list(x = 2),
     ),
     list(a = list(x = 2))
   )
@@ -55,11 +47,18 @@ test_that("lists are replaced recursively", {
   )
 })
 
-test_that("duplicate names works", {
-  expect_equal(list_modify(list(x = 1), x = 2, x = 3), list(x = 3))
+test_that("but data.frames are not", {
+  x1 <- list(x = data.frame(x = 1))
+  x2 <- list(x = data.frame(y = 2))
+  out <- list_modify(x1, !!!x2)
+  expect_equal(out, x2)
 })
 
-
+test_that("list_modify() validates inputs", {
+  expect_snapshot(list_modify(1:3), error = TRUE)
+  expect_snapshot(list_modify(list(a = 1), 2, a = 2), error = TRUE)
+  expect_snapshot(list_modify(list(x = 1), x = 2, x = 3), error = TRUE)
+})
 
 # list_merge --------------------------------------------------------------
 
@@ -85,8 +84,9 @@ test_that("list_merge returns the non-empty list", {
   expect_equal(list_merge(list(), 2), list(2))
 })
 
-test_that("list_merge handles duplicate names", {
-  expect_equal(list_merge(list(x = 1), x = 2, x = 3), list(x = 1:3))
+test_that("merge() validates inputs", {
+  expect_snapshot(list_merge(1:3), error = TRUE)
+  expect_snapshot(list_merge(list(x = 1), x = 2, x = 3), error = TRUE)
 })
 
 # update_list ------------------------------------------------------------
@@ -107,15 +107,3 @@ test_that("quosures and formulas are evaluated", {
   expect_identical(update_list(list(x = 1), y = quo(x + 1)), list(x = 1, y = 2))
   expect_identical(update_list(list(x = 1), y = ~x + 1), list(x = 1, y = 2))
 })
-
-
-# Life cycle --------------------------------------------------------------
-
-test_that("removing elements with `NULL` is deprecated", {
-  expect_snapshot(. <- list_modify(list(1, 2, 3), NULL))
-})
-
-test_that("can still remove elements with `NULL`", {
-  local_options(lifecycle_verbosity = "quiet")
-  expect_equal(list_modify(list(1, 2, 3), NULL, NULL), list(3))
-})