Fix reverse dependency issue with facet labelling (#6471)

* convert `check_labeller()` to `validate_labeller()`

* add small test

Author: teunbrand

R/facet-grid-.R

@@ -187,7 +187,7 @@ facet_grid <- function(rows = NULL, cols = NULL, scales = "fixed",
   facets_list <- grid_as_facets_list(rows, cols)
 
   # Check for deprecated labellers
-  check_labeller(labeller)
+  labeller <- validate_labeller(labeller)
 
   ggproto(NULL, FacetGrid,
     shrink = shrink,

R/facet-wrap.R

@@ -188,7 +188,7 @@ facet_wrap <- function(facets, nrow = NULL, ncol = NULL, scales = "fixed",
   )
 
   # Check for deprecated labellers
-  check_labeller(labeller)
+  labeller <- validate_labeller(labeller)
 
   # Flatten all facets dimensions into a single one
   facets <- compact_facets(facets)

R/labeller.R

@@ -578,13 +578,13 @@ assemble_strips <- function(grobs, theme, horizontal = TRUE, clip) {
 }
 
 # Reject old school labeller
-check_labeller <- function(labeller) {
+validate_labeller <- function(labeller) {
 
   labeller <- match.fun(labeller)
   is_deprecated <- all(c("variable", "value") %in% names(formals(labeller)))
 
   if (!is_deprecated) {
-    return(invisible())
+    return(labeller)
   }
 
   lifecycle::deprecate_stop(

tests/testthat/test-labellers.R

@@ -1,3 +1,11 @@
+test_that("facets convert labeller to function", {
+  f <- facet_grid(foo ~ bar, labeller = "label_both")
+  expect_type(f$params$labeller, "closure")
+
+  f <- facet_wrap(foo ~ bar, labeller = "label_value")
+  expect_type(f$params$labeller, "closure")
+})
+
 test_that("label_bquote has access to functions in the calling environment", {
   labels <- data.frame(lab = letters[1:2])
   attr(labels, "facet") <- "wrap"