Improve warnings in indirect usages

NEWS.md

@@ -1,13 +1,20 @@
 # lifecycle (development version)
 
+* Indirect usages of deprecated features now mention the package that
+  likely used the deprecated feature and recommends contacting the
+  authors (#135).
+
+* Indirect usages of `deprecate_warn()` no longer warn repeatedly,
+  even if `always = TRUE` (#135).
+
 * In tests, `deprecate_soft()` will only warn if the deprecated function
   is called directly from the package being tested, not one of its dependencies.
-  This ensures that you only see the warning when it's your responsibility to 
+  This ensures that you only see the warning when it's your responsibility to
   do something about it (#134).
-  
-* `deprecate_soft()` will never warn when called on CRAN, ensuring that soft 
+
+* `deprecate_soft()` will never warn when called on CRAN, ensuring that soft
   deprecation will never break a reverse dependency (#134).
-  
+
 * Soft deprecations now only warn every 8 hours in non-package code (#134).
 
 # lifecycle 1.0.2

R/deprecate.R

@@ -102,47 +102,69 @@ deprecate_soft <- function(when,
   signal_stage("deprecated", what)
 
   verbosity <- lifecycle_verbosity()
-  if (verbosity == "quiet") {
-    NULL
-  } else if (verbosity %in% c("warning", "default")) {
-    if (is_direct(user_env)) {
-      always <- verbosity == "warning"
-      deprecate_warn0(msg, id, trace_back(bottom = caller_env()), always = always)
-    }
-  } else if (verbosity == "error") {
-    deprecate_stop0(msg)
-  }
-
-  invisible(NULL)
+  direct <- is_direct(user_env)
+
+  invisible(switch(
+    verbosity,
+    quiet = NULL,
+    warning = ,
+    default =
+      if (direct) {
+        always <- verbosity == "warning"
+        trace <- trace_back(bottom = caller_env())
+        deprecate_warn0(
+          msg,
+          id,
+          trace,
+          always = always,
+          direct = TRUE,
+          user_env = user_env
+        )
+      },
+    error = deprecate_stop0(msg)
+  ))
 }
 
 #' @rdname deprecate_soft
-#' @param always If `FALSE`, the default, will warn every 8 hours.
-#'   If `TRUE`, will always warn. Only use `always = TRUE` after at least
-#'   one release with the default.
+#' @param always If `FALSE`, the default, will warn every 8 hours.  If
+#'   `TRUE`, will always warn in direct usages. Indirect usages keep
+#'   warning every 8 hours to avoid disrupting users who can't fix the
+#'   issue. Only use `always = TRUE` after at least one release with
+#'   the default.
 #' @export
 deprecate_warn <- function(when,
                            what,
                            with = NULL,
                            details = NULL,
                            id = NULL,
                            always = FALSE,
-                           env = caller_env()) {
+                           env = caller_env(),
+                           user_env = caller_env(2)) {
   msg <- NULL # trick R CMD check
   msg %<~% lifecycle_message(when, what, with, details, env, "deprecate_warn")
   signal_stage("deprecated", what)
 
   verbosity <- lifecycle_verbosity()
-  if (verbosity == "quiet") {
-    NULL
-  } else if (verbosity %in% c("default", "warning")) {
-    always <- always || verbosity == "warning"
-    deprecate_warn0(msg, id, trace_back(bottom = caller_env()), always = always)
-  } else if (verbosity == "error") {
-    deprecate_stop0(msg)
-  }
 
-  invisible(NULL)
+  invisible(switch(
+    verbosity,
+    quiet = NULL,
+    warning = ,
+    default = {
+      direct <- is_direct(user_env)
+      always <- direct && (always || verbosity == "warning")
+      trace <- trace_back(bottom = caller_env())
+      deprecate_warn0(
+        msg,
+        id,
+        trace,
+        always = always,
+        direct = direct,
+        user_env = user_env
+      )
+    },
+    error = deprecate_stop0(msg),
+  ))
 }
 
 #' @rdname deprecate_soft
@@ -164,7 +186,9 @@ deprecate_warn0 <- function(msg,
                             id = NULL,
                             trace = NULL,
                             always = FALSE,
-                            call = caller_env()) {
+                            direct = FALSE,
+                            call = caller_env(),
+                            user_env = caller_env(2)) {
   id <- id %||% msg
   if (!always && !needs_warning(id, call = call)) {
     return()
@@ -174,12 +198,34 @@ deprecate_warn0 <- function(msg,
   env_poke(deprecation_env, id, Sys.time())
 
   footer <- function(...) {
+    footer <- NULL
+
+    if (!direct) {
+      top <- topenv(user_env)
+
+      if (is_namespace(top)) {
+        pkg <- ns_env_name(top)
+        footer <- c(
+          footer,
+          "i" = cli::format_inline(
+            "The deprecated feature was likely used in the {.pkg {pkg}} package."
+          ),
+          " " = cli::format_inline(
+            "Please report the issue to the authors."
+          )
+        )
+      }
+    }
+
     if (is_interactive()) {
-      c(
+      footer <- c(
+        footer,
         if (!always) silver("This warning is displayed once every 8 hours."),
         silver("Call `lifecycle::last_lifecycle_warnings()` to see where this warning was generated.")
       )
     }
+
+    footer
   }
   wrn <- new_deprecated_warning(msg, trace, footer = footer)
 

tests/testthat/_snaps/deprecate.md

@@ -1,25 +1,40 @@
 # deprecate_warn() only warns repeatedly if always = TRUE
 
     Code
-      deprecate()
+      direct()
     Condition
       Warning:
       `foo()` was deprecated in lifecycle 1.0.0.
     Code
-      deprecate()
+      direct()
+      indirect()
+      indirect()
 
 ---
 
     Code
-      deprecate(always = TRUE)
+      direct(always = TRUE)
     Condition
       Warning:
       `foo()` was deprecated in lifecycle 1.0.0.
     Code
-      deprecate(always = TRUE)
+      direct(always = TRUE)
     Condition
       Warning:
       `foo()` was deprecated in lifecycle 1.0.0.
+    Code
+      indirect(always = TRUE)
+      indirect(always = TRUE)
+
+# indirect usage recommends contacting authors
+
+    Code
+      indirect()
+    Condition
+      Warning:
+      `foo()` was deprecated in lifecycle 1.0.0.
+      i The deprecated feature was likely used in the base package.
+        Please report the issue to the authors.
 
 # what deprecation messages are readable
 

tests/testthat/helper-lifecycle.R

@@ -1,4 +1,3 @@
-
 expect_lifecycle_defunct <- function(object, ...) {
   expect_error(object, class = "defunctError")
 }
@@ -29,3 +28,13 @@ spec_data <- function(fn = NULL,
     from = from
   )
 }
+
+new_callers <- function(deprecated_feature, env = caller_env()) {
+  direct <- inject(function(...) (!!deprecated_feature)(...))
+  indirect <- inject(function(...) (!!deprecated_feature)(...))
+
+  environment(direct) <- global_env()
+  environment(indirect) <- ns_env("base")
+
+  list(direct, indirect)
+}

tests/testthat/helper-zeallot.R

@@ -0,0 +1,34 @@
+# nocov start --- compat-zeallot --- 2020-11-23
+
+# This drop-in file implements a simple version of zeallot::`%<-%`.
+# Please find the most recent version in rlang's repository.
+
+
+`%<-%` <- function(lhs, value) {
+  lhs <- substitute(lhs)
+  env <- caller_env()
+
+  if (!is_call(lhs, "c")) {
+    abort("The left-hand side of `%<-%` must be a call to `c()`.")
+  }
+
+  vars <- as.list(lhs[-1])
+
+  if (length(value) != length(vars)) {
+    abort("The left- and right-hand sides of `%<-%` must be the same length.")
+  }
+
+  for (i in seq_along(vars)) {
+    var <- vars[[i]]
+    if (!is_symbol(var)) {
+      abort(paste0("Element ", i, " of the left-hand side of `%<-%` must be a symbol."))
+    }
+
+    env[[as_string(var)]] <- value[[i]]
+  }
+
+  invisible(value)
+}
+
+
+# nocov end

tests/testthat/test-deprecate.R

@@ -4,27 +4,47 @@ test_that("default deprecations behave as expected", {
   on.exit(env_unbind(deprecation_env, "test"))
   local_options(lifecycle_verbosity = "default")
 
-  expect_warning(deprecate_warn("1.0.0", "foo()", id = "test"), class = "lifecycle_warning_deprecated")
-  expect_warning(deprecate_warn("1.0.0", "foo()", id = "test"), NA)
+  deprecated_feature <- function(...) deprecate_warn("1.0.0", "foo()", id = "test", ...)
+  c(direct, indirect) %<-% new_callers(deprecated_feature)
+
+  expect_warning(direct(), class = "lifecycle_warning_deprecated")
+  expect_warning(indirect(), NA)
+  expect_warning(indirect(), NA)
+
   expect_defunct(deprecate_stop("1.0.0", "foo()"))
 })
 
 test_that("deprecate_warn() only warns repeatedly if always = TRUE", {
   on.exit(env_unbind(deprecation_env, "test"))
   local_options(lifecycle_verbosity = "default")
 
-  deprecate <- function(...) {
-    deprecate_warn("1.0.0", "foo()", id = "test", ...)
-  }
+  deprecated_feature <- function(...) deprecate_warn("1.0.0", "foo()", id = "test", ...)
+  c(direct, indirect) %<-% new_callers(deprecated_feature)
+
+  expect_snapshot({
+    direct()
+    direct()
+    indirect()
+    indirect()
+  })
 
   expect_snapshot({
-    deprecate()
-    deprecate()
+    direct(always = TRUE)
+    direct(always = TRUE)
+    indirect(always = TRUE)
+    indirect(always = TRUE)
   })
+})
+
+test_that("indirect usage recommends contacting authors", {
+  on.exit(env_unbind(deprecation_env, "test"))
+  local_options(lifecycle_verbosity = "default")
+
+  deprecated_feature <- function(...) deprecate_warn("1.0.0", "foo()", id = "test", ...)
+  c(direct, indirect) %<-% new_callers(deprecated_feature)
 
   expect_snapshot({
-    deprecate(always = TRUE)
-    deprecate(always = TRUE)
+    indirect()
   })
 })
 
@@ -79,10 +99,15 @@ test_that("soft deprecation uses correct calling envs", {
 test_that("warning conditions are signaled only once if warnings are suppressed", {
   local_options(lifecycle_verbosity = "warning")
 
+  deprecated_feature <- function(...) deprecate_warn(...)
+  c(direct, indirect) %<-% new_callers(deprecated_feature)
+
   x <- 0L
   suppressWarnings(withCallingHandlers(
-    warning = function(...) x <<- x + 1L,
-    deprecate_warn("1.0.0", "foo()")
+    warning = function(...) x <<- x + 1L, {
+      direct("1.0.0", "foo()")
+      indirect("1.0.0", "foo()")
+    }
   ))
 
   expect_identical(x, 1L)