functions pass quosures around; resolves #29

R/ggbody.R

@@ -83,15 +83,19 @@
 ggbody <- function(method, inherit = FALSE) {
 
   # Capture method expression
-  method_expr <- rlang::enexpr(method)
+  method_quo <- rlang::enquo(method)
+  if (rlang::is_quosure(method)) {
+    method_quo <- method
+  }
+  method_expr <- rlang::quo_get_expr(method_quo)
 
   # Check if method is a call
   if (!rlang::is_call(method_expr)) {
     rlang::abort("`method` must be a call. See `?ggbody` for valid forms.")
   }
 
   # Parse/deparse method and obj
-  method_split <- eval(rlang::expr(split_ggproto_method(!!method_expr)))
+  method_split <- split_ggproto_method(method_quo)
   method_name <- method_split[["method_name"]]
   obj <- method_split[["obj"]]
   obj_name <- method_split[["obj_name"]]

R/ggedit.R

@@ -25,13 +25,13 @@
 ggedit <- function(method, ...) {
 
   # Capture method expression
-  method_expr <- rlang::enexpr(method)
+  method_expr <- rlang::enquo(method)
 
   # Validate method
-  method_body <- eval(rlang::expr(ggbody(!!method_expr)))
+  method_body <- ggbody(method_expr)
 
   # Parse/deparse method and obj
-  method_split <- eval(rlang::expr(split_ggproto_method(!!method_expr)))
+  method_split <- split_ggproto_method(method_expr)
   method_name <- method_split[["method_name"]]
   obj <- method_split[["obj"]]
   obj_name <- method_split[["obj_name"]]

R/ggtrace.R

@@ -105,13 +105,13 @@
 ggtrace <- function(method, trace_steps, trace_exprs, once = TRUE, .print = TRUE) {
 
   # Capture method expression
-  method_expr <- rlang::enexpr(method)
+  method_expr <- rlang::enquo(method)
 
   # Validate method
-  method_body <- eval(rlang::expr(ggbody(!!method_expr)))
+  method_body <- ggbody(method_expr)
 
   # Parse/deparse method and obj
-  method_split <- eval(rlang::expr(split_ggproto_method(!!method_expr)))
+  method_split <- split_ggproto_method(method_expr)
   method_name <- method_split[["method_name"]]
   obj <- method_split[["obj"]]
   obj_name <- method_split[["obj_name"]]

R/gguntrace.R

@@ -29,13 +29,13 @@
 gguntrace <- function(method, ...) {
 
   # Capture method expression
-  method_expr <- rlang::enexpr(method)
+  method_expr <- rlang::enquo(method)
 
   # Validate method
-  method_body <- eval(rlang::expr(ggbody(!!method_expr)))
+  method_body <- ggbody(method_expr)
 
   # Parse/deparse method and obj
-  method_split <- eval(rlang::expr(split_ggproto_method(!!method_expr)))
+  method_split <- split_ggproto_method(method_expr)
   method_name <- method_split[["method_name"]]
   obj <- method_split[["obj"]]
   obj_name <- method_split[["obj_name"]]

R/utils.R

@@ -1,13 +1,19 @@
-split_ggproto_method <- function(method_expr) {
-  method_deparsed <- rlang::as_label(rlang::enexpr(method_expr))
+split_ggproto_method <- function(method) {
+  method_expr <- rlang::enexpr(method)
+  eval_env <- parent.frame()
+  if (rlang::is_quosure(method)) {
+    method_expr <- rlang::quo_get_expr(method)
+    eval_env <- rlang::quo_get_env(method)
+  }
+  method_deparsed <- rlang::as_label(method_expr)
   if (!grepl("\\$", method_deparsed)) {
     rlang::abort("Invalid method expression. See `?ggbody` for valid forms.")
   }
   both <- strsplit(method_deparsed, split = "$", fixed = TRUE)[[1]]
   obj_expr <- rlang::parse_expr(both[[1]])
   split_list <- list(
     method_name = both[[2]],
-    obj = eval(obj_expr),
+    obj = eval(obj_expr, envir = eval_env),
     obj_name = both[[1]],
     ns = gsub("(^|:::?)[^:]*?$", "", method_deparsed)
   )

tests/testthat/test-ggbody.R

@@ -1,5 +1,4 @@
 library(ggplot2)
-library(ggforce)
 
 StatDensityCommon <- ggproto("StatDensityCommon", Stat,
                              required_aes = "x",
@@ -25,8 +24,8 @@ StatDensityCommon <- ggproto("StatDensityCommon", Stat,
 
 test_that("ggbody gets body as list", {
   expect_equal(
-    ggbody(StatBezier$compute_panel),
-    as.list(body(get("compute_panel", StatBezier)))
+    ggbody(GeomRect$draw_panel),
+    as.list(body(get("draw_panel", GeomRect)))
   )
   expect_equal(
     ggbody(StatDensityCommon$compute_group),
@@ -40,19 +39,11 @@ test_that("ggbody gets body as list", {
   )
 })
 
-test_that("Works with :: and :::", {
+test_that("Works with unimported :::", {
   expect_equal(
     ggbody(ggplot2:::Layer$compute_position),
     as.list(body(get("compute_position", ggplot2:::Layer)))
   )
-  expect_equal(
-    ggbody(ggforce::StatBezier$compute_panel),
-    as.list(body(get("compute_panel", StatBezier)))
-  )
-  expect_equal(
-    ggbody(ggrepel::GeomTextRepel$draw_panel),
-    as.list(body(get("draw_panel", ggrepel::GeomTextRepel)))
-  )
 })
 
 test_that("errors if method missing or not defined for ggproto object", {
@@ -64,10 +55,6 @@ test_that("errors if method missing or not defined for ggproto object", {
     ggbody(StatBoxplot$not_a_method),
     "Method .* not defined for .*"
   )
-  expect_error(
-    ggbody(ggrepel::GeomTextRepel$compute_panel),
-    "Method .* not defined for .*"
-  )
   expect_error(
     ggbody(StatDensityCommon$compute_panel),
     "Method .* not defined for .*"
@@ -93,21 +80,25 @@ test_that("errors if object not defined", {
 })
 
 test_that("returns method from closest parent in a message", {
+  expect_equal(
+    class(GeomAnnotationMap),
+    c("GeomAnnotationMap", "GeomMap", "GeomPolygon", "Geom", "ggproto", "gg")
+  )
   expect_message(
-    ggbody(GeomArcBar$default_aes, inherit = TRUE),
+    ggbody(GeomAnnotationMap$draw_panel, inherit = TRUE),
     "not inherited"
   )
   expect_message(
-    ggbody(GeomArcBar$draw_panel, inherit = TRUE),
-    "GeomShape\\$draw_panel"
+    ggbody(GeomAnnotationMap$required_aes, inherit = TRUE),
+    "GeomMap\\$required_aes"
   )
   expect_message(
-    ggbody(GeomArcBar$draw_key, inherit = TRUE),
+    ggbody(GeomAnnotationMap$draw_key, inherit = TRUE),
     "GeomPolygon\\$draw_key"
   )
   expect_message(
-    ggbody(GeomArcBar$draw_group, inherit = TRUE),
-    "Geom\\$draw_group"
+    ggbody(GeomAnnotationMap$draw_layer, inherit = TRUE),
+    "Geom\\$draw_layer"
   )
   expect_message(
     ggbody(StatDensityCommon$compute_panel, inherit = TRUE),
@@ -124,10 +115,6 @@ test_that("returns same with or without :: and :::", {
     ggbody(StatBin$compute_group),
     ggbody(ggplot2:::StatBin$compute_group)
   )
-  expect_equal(
-    ggbody(FacetCol$draw_panels),
-    ggbody(ggforce::FacetCol$draw_panels)
-  )
 })
 
 test_that("handles non-functions", {

tests/testthat/test-utils.R

@@ -22,10 +22,6 @@ test_that("namespace is captured correctly", {
     split_ggproto_method(ggplot2:::Layer$compute_statistic)$ns,
     "ggplot2"
   )
-  expect_equal(
-    split_ggproto_method(ggforce::StatSina$compute_group)$ns,
-    "ggforce"
-  )
 })
 
 test_that("handle private variables differently from methods", {