draft of layer_is()

DESCRIPTION

@@ -17,7 +17,7 @@ Depends: R (>= 3.3.0)
 License: MIT + file LICENSE
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.2
 Collate:
   'utils.R'
   'helpers.R'

NAMESPACE

@@ -2,6 +2,7 @@
 
 S3method(plot,ggtrace_highjacked)
 S3method(print,ggtrace_highjacked)
+export(.layer_is)
 export(capture_env)
 export(capture_fn)
 export(clear_global_ggtrace)
@@ -47,6 +48,7 @@ export(layer_after_scale)
 export(layer_after_stat)
 export(layer_before_geom)
 export(layer_before_stat)
+export(layer_is)
 export(set_global_ggtrace)
 export(set_last_ggtrace)
 export(with_ggtrace)

R/sublayer-data.R

@@ -1,7 +1,9 @@
 #' Inspect snapshots of sub-layer data
 #'
-#' `layer_before_stat()`, `layer_after_stat()`, `layer_before_geom()`, and `layer_after_scale()`
-#' are helper functions that return a snapshot of a layer's data in the internals.
+#' `layer_before_stat()`, `layer_after_stat()`, `layer_before_geom()`, and
+#' `layer_after_scale()` are convenience functions that return a snapshot of
+#' a layer's data in the internals. `layer_is()` is a helper function used by
+#' these.
 #'
 #' @name sublayer-data
 #'
@@ -83,13 +85,13 @@ sublayer_data <- function(x, cond = 1L,
   }
 
   inspect_expr <- rlang::call2(
-    paste0("ggtrace_inspect_", step[1]),
+    paste0("inspect_", step[1]),
     x_expr,
     rlang::parse_expr(step[2]),
     .ns = "ggtrace"
   )
 
-  if (cond != 1L) inspect_expr$cond <- cond
+  inspect_expr[[4]] <- rlang::expr(layer_is(!!cond))
   if (!isFALSE(error)) inspect_expr$error <- error
   if (step[1] == "args") inspect_expr <- call("$", inspect_expr, quote(data))
 
@@ -98,8 +100,10 @@ sublayer_data <- function(x, cond = 1L,
   if (!verbose) options(rethrow_error)
 
   inspect_expr_fmt <- rlang::expr_deparse(inspect_expr, width = Inf)
-  inspect_expr_fmt <- gsub("^ggtrace::", "", inspect_expr_fmt)
-  if (verbose) cli::cli_alert_success("Executed {.code {inspect_expr_fmt}}")
+  if ("package:ggtrace" %in% search()) {
+    inspect_expr_fmt <- gsub("^ggtrace::", "", inspect_expr_fmt)
+  }
+  if (verbose) cli::cli_alert_success("Ran {.code {inspect_expr_fmt}}")
 
   if (rlang::is_installed("tibble")) {
     out <- asNamespace("tibble")$as_tibble(out)
@@ -137,3 +141,53 @@ layer_after_scale <- function(plot, i = 1L, ..., error = FALSE, verbose = TRUE)
                 ..., error = error, verbose = verbose)
 }
 
+#' @rdname sublayer-data
+#' @param expr An expression to evaluate for each call to the method, which
+#'   exposes information about the current layer that the method is being
+#'   called for. In technical terms, `layer_is()` subsets calls to the method
+#'   that are downstream of the `by_layer()` function in the ggplot internals.
+#'   It exposes some context-dependent variables, including:
+#'   * `i`: Scalar integer representing the nth layer
+#'   * `layers`: A list whose contents are equivalent to `<ggplot>$layers`
+#' @export
+layer_is <- function(expr) {
+  x <- rlang::enexpr(expr)
+  rlang::expr(.layer_is(!!x))
+}
+
+#' @rdname sublayer-data
+#' @export
+.layer_is <- function(expr) {
+
+  x <- rlang::enexpr(expr)
+
+  invalid_trace_msg <- function(x) {
+    sprintf("Invalid context: must be called from {.fn %s}.", x)
+  }
+  if (!any(sapply(sys.calls(), rlang::is_call, "ggplot_build"))) {
+    cli::cli_abort(invalid_trace_msg("ggplot_build"))
+  }
+  by_layer_idx <- which(sapply(sys.calls(), rlang::is_call, "by_layer"))[1]
+  if (is.na(by_layer_idx)) {
+    return(FALSE)
+  }
+  by_layer_env <- rlang::env_clone(sys.frames()[[by_layer_idx]])
+
+  if (is.numeric(x)) {
+    n_layers <- length(by_layer_env$layers)
+    if (x > n_layers) {
+      cli::cli_abort(
+        "[ggtrace] Plot has {n_layers} layer{?s} - {x} is invalid.",
+        call = rlang::call2("layer_is", x)
+      )
+    }
+    x <- rlang::call2("==", quote(i), as.integer(x))
+  }
+
+  keep <- c("i", "layers")
+  drop <- setdiff(rlang::env_names(by_layer_env), keep)
+  rlang::env_unbind(by_layer_env, nms = drop)
+
+  isTRUE(rlang::eval_bare(x, by_layer_env))
+
+}