Merge pull request #271 from toppyy/scrub_function_defs

R/telemetry.R

@@ -237,7 +237,7 @@ expr_to_json <- function(x, name_map) {
   expr_deparse(scrubbed, width = 500L)
 }
 
-expr_scrub <- function(x, name_map) {
+expr_scrub <- function(x, name_map = character()) {
   do_scrub <- function(xx, callee = FALSE) {
     if (is.character(xx))  {
       return("<character>")
@@ -248,6 +248,9 @@ expr_scrub <- function(x, name_map) {
       return(xx)
     } else if (is.atomic(xx)) {
       return(xx)
+    } else if (is_missing(xx)) {
+      # Arguments without default values are empty
+      return(xx)
     } else if (is_symbol(xx)) {
       if (callee) {
         return(xx)
@@ -264,6 +267,8 @@ expr_scrub <- function(x, name_map) {
     } else if (is_call(xx)) {
       args <- map(as.list(xx)[-1], do_scrub)
       call2(do_scrub(xx[[1]], callee = TRUE), !!!args)
+    } else if (is_pairlist(xx)) {
+      as.pairlist(map(as.list(xx), do_scrub))
     } else {
       paste0("Don't know how to scrub ", paste(class(xx), collapse = "/"))
     }

tests/testthat/_snaps/telemetry.md

@@ -327,3 +327,11 @@
       Error in `rel_try()`:
       ! union_all: {"version":"0.3.1","message":"Error in union_all","name":"union_all","x":{"...1":"integer","...2":"integer"},"y":{"...1":"integer","...2":"integer"}}
 
+# scrubbing function declarations
+
+    Code
+      expr <- expr(across(x:y, function(arg) mean(arg, na.rm = TRUE)))
+      expr_scrub(expr)
+    Output
+      across(...1:...2, function(arg) mean(...3, na.rm = TRUE))
+

tests/testthat/test-telemetry.R

@@ -326,3 +326,13 @@ test_that("telemetry and union_all()", {
       union_all(tibble(a = 1:3, b = 4:6))
   })
 })
+
+test_that("scrubbing function declarations", {
+  expect_snapshot({
+    expr <- expr(
+      across(x:y, function(arg) mean(arg, na.rm = TRUE))
+    )
+
+    expr_scrub(expr)
+  })
+})