Ensure ggproto methods start with { (#6460)

* add curly braces

* add test

* spell out identity()

* bracket `Scale$palette()`

* report potential test failures

* add positive/negative control to test

* fix test

---------

Co-authored-by: Teun van den Brand <[email protected]>

Author: yjunechoe

R/coord-cartesian-.R

@@ -97,8 +97,14 @@ coord_cartesian <- function(xlim = NULL, ylim = NULL, expand = TRUE,
 #' @export
 CoordCartesian <- ggproto("CoordCartesian", Coord,
 
-  is_linear = function() TRUE,
-  is_free = function(self) is.null(self$ratio),
+  is_linear = function() {
+    TRUE
+  },
+
+  is_free = function(self) {
+    is.null(self$ratio)
+  },
+
   aspect = function(self, ranges) {
     if (is.null(self$ratio)) {
       return(NULL)

R/coord-fixed.R

@@ -37,7 +37,9 @@ coord_equal <- coord_fixed
 #' @usage NULL
 #' @export
 CoordFixed <- ggproto("CoordFixed", CoordCartesian,
-  is_free = function() FALSE,
+  is_free = function() {
+    FALSE
+  },
 
   aspect = function(self, ranges) {
     diff(ranges$y.range) / diff(ranges$x.range) * self$ratio

R/coord-polar.R

@@ -20,9 +20,13 @@ coord_polar <- function(theta = "x", start = 0, direction = 1, clip = "on") {
 #' @export
 CoordPolar <- ggproto("CoordPolar", Coord,
 
-  aspect = function(details) 1,
+  aspect = function(details) {
+    1
+  },
 
-  is_free = function() TRUE,
+  is_free = function() {
+    TRUE
+  },
 
   distance = function(self, x, y, details, boost = 0.75) {
     arc <- self$start + c(0, 2 * pi)

R/coord-radial.R

@@ -199,7 +199,9 @@ CoordRadial <- ggproto("CoordRadial", Coord,
     diff(details$bbox$y) / diff(details$bbox$x)
   },
 
-  is_free = function() TRUE,
+  is_free = function() {
+    TRUE
+  },
 
   distance = function(self, x, y, details, boost = 0.75) {
     arc <- details$arc %||% c(0, 2 * pi)

R/coord-sf.R

@@ -303,11 +303,15 @@ CoordSf <- ggproto("CoordSf", CoordCartesian,
   },
 
   # CoordSf enforces a fixed aspect ratio -> axes cannot be changed freely under faceting
-  is_free = function() FALSE,
+  is_free = function() {
+    FALSE
+  },
 
   # for regular geoms (such as geom_path, geom_polygon, etc.), CoordSf is non-linear
   # if the default_crs option is being used, i.e., not set to NULL
-  is_linear = function(self) is.null(self$get_default_crs()),
+  is_linear = function(self) {
+    is.null(self$get_default_crs())
+  },
 
   distance = function(self, x, y, panel_params) {
     d <- self$backtransform_range(panel_params)
@@ -328,7 +332,9 @@ CoordSf <- ggproto("CoordSf", CoordCartesian,
     diff(panel_params$y_range) / diff(panel_params$x_range) / ratio
   },
 
-  labels = function(labels, panel_params) labels,
+  labels = function(labels, panel_params) {
+    labels
+  },
 
   render_bg = function(self, panel_params, theme) {
     el <- calc_element("panel.grid.major", theme)

R/coord-transform.R

@@ -126,7 +126,11 @@ coord_trans <- function(...) {
 #' @export
 CoordTransform <- ggproto(
   "CoordTransform", Coord,
-  is_free = function() TRUE,
+
+  is_free = function() {
+    TRUE
+  },
+
   distance = function(self, x, y, panel_params) {
     max_dist <- dist_euclidean(panel_params$x.range, panel_params$y.range)
     dist_euclidean(self$trans$x$transform(x), self$trans$y$transform(y)) / max_dist

R/geom-blank.R

@@ -35,7 +35,11 @@ geom_blank <- function(mapping = NULL, data = NULL,
 #' @export
 GeomBlank <- ggproto("GeomBlank", Geom,
   default_aes = aes(),
-  handle_na = function(data, params) data,
+  handle_na = function(data, params) {
+    data
+  },
   check_constant_aes = FALSE,
-  draw_panel = function(...) nullGrob()
+  draw_panel = function(...) {
+    nullGrob()
+  }
 )

R/scale-.R

@@ -458,7 +458,9 @@ Scale <- ggproto("Scale", NULL,
   #' as described in e.g. [`?continuous_scale`][continuous_scale].
   #' Note that `limits` is expected in transformed space.
   aesthetics = character(),
-  palette = function() cli::cli_abort("Not implemented."),
+  palette = function() {
+    cli::cli_abort("Not implemented.")
+  },
 
   limits = NULL,
   na.value = NA,
@@ -998,7 +1000,9 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale,
   n.breaks = NULL,
   trans = transform_identity(),
 
-  is_discrete = function() FALSE,
+  is_discrete = function() {
+    FALSE
+  },
 
   train = function(self, x) {
     if (length(x) == 0) {
@@ -1257,7 +1261,9 @@ ScaleDiscrete <- ggproto("ScaleDiscrete", Scale,
   n.breaks.cache = NULL,
   palette.cache = NULL,
 
-  is_discrete = function() TRUE,
+  is_discrete = function() {
+    TRUE
+  },
 
   train = function(self, x) {
     if (length(x) == 0) {
@@ -1271,7 +1277,9 @@ ScaleDiscrete <- ggproto("ScaleDiscrete", Scale,
     )
   },
 
-  transform = identity,
+  transform = function(self, x) {
+    x
+  },
 
   map = function(self, x, limits = self$get_limits()) {
     limits <- vec_slice(limits, !is.na(limits))
@@ -1483,7 +1491,9 @@ ScaleBinned <- ggproto("ScaleBinned", Scale,
   after.stat = FALSE,
   show.limits = FALSE,
 
-  is_discrete = function() FALSE,
+  is_discrete = function() {
+    FALSE
+  },
 
   train = function(self, x) {
     if (length(x) == 0) {
@@ -1644,7 +1654,9 @@ ScaleBinned <- ggproto("ScaleBinned", Scale,
     transformation$transform(breaks)
   },
 
-  get_breaks_minor = function(...) NULL,
+  get_breaks_minor = function(...) {
+    NULL
+  },
 
   get_labels = function(self, breaks = self$get_breaks()) {
     if (is.null(breaks)) return(NULL)

R/scale-view.R

@@ -107,13 +107,27 @@ ViewScale <- ggproto("ViewScale", NULL,
   is_empty = function(self) {
     is.null(self$get_breaks()) && is.null(self$get_breaks_minor())
   },
-  is_discrete = function(self) self$scale_is_discrete,
-  dimension = function(self) self$continuous_range,
-  get_limits = function(self) self$limits,
-  get_breaks = function(self) self$breaks,
-  get_breaks_minor = function(self) self$minor_breaks,
-  get_labels = function(self, breaks = self$get_breaks()) self$scale$get_labels(breaks),
-  get_transformation = function(self) self$scale$get_transformation(),
+  is_discrete = function(self) {
+    self$scale_is_discrete
+  },
+  dimension = function(self) {
+    self$continuous_range
+  },
+  get_limits = function(self) {
+    self$limits
+  },
+  get_breaks = function(self) {
+    self$breaks
+  },
+  get_breaks_minor = function(self) {
+    self$minor_breaks
+  },
+  get_labels = function(self, breaks = self$get_breaks()) {
+    self$scale$get_labels(breaks)
+  },
+  get_transformation = function(self) {
+    self$scale$get_transformation()
+  },
   rescale = function(self, x) {
     self$scale$rescale(x, self$limits, self$continuous_range)
   },

R/stat-unique.R

@@ -4,7 +4,9 @@
 #' @export
 StatUnique <- ggproto(
   "StatUnique", Stat,
-  compute_panel = function(data, scales) unique0(data)
+  compute_panel = function(data, scales) {
+    unique0(data)
+  }
 )
 
 #' Remove duplicates

tests/testthat/test-ggproto.R

@@ -10,3 +10,48 @@ test_that("construction checks input", {
   expect_snapshot_error(ggproto("Test", NULL, a <- function(self, a) a))
   expect_snapshot_error(ggproto("Test", mtcars, a = function(self, a) a))
 })
+
+test_that("all ggproto methods start with `{` (#6459)", {
+
+  ggprotos <- Filter(
+    function(x) inherits(x, "ggproto"),
+    mget(ls("package:ggplot2"), asNamespace("ggplot2"), ifnotfound = list(NULL))
+  )
+
+  lacks_brackets <- function(method) {
+    if (!inherits(method, "ggproto_method")) {
+      return(FALSE)
+    }
+    body <- as.list(body(environment(method)$f))
+    if (length(body) == 0 || body[[1]] != quote(`{`)) {
+      return(TRUE)
+    }
+    return(FALSE)
+  }
+
+  report_no_bracket <- function(ggproto_class) {
+    unlist(lapply(
+      ls(envir = ggproto_class),
+      function(method) {
+        has_brackets <- !lacks_brackets(ggproto_class[[method]])
+        if (has_brackets) {
+          return(character())
+        }
+        return(method)
+      }
+    ))
+  }
+
+  # Test to make sure we're testing correctly
+  ctrl <- list(
+    foo = ggproto("Dummy", dummy = function(x) x + 10),
+    bar = ggproto("Dummy", dummy = function(x) {x + 10})
+  )
+  ctrl <- lapply(ctrl, report_no_bracket)
+  expect_equal(ctrl, list(foo = "dummy", bar = character()))
+
+  # Actual relevant test
+  failures <- lapply(ggprotos, report_no_bracket)
+  failures <- failures[lengths(failures) > 0]
+  expect_equal(names(failures), character())
+})