as.list() methods for S7 classes (#6699)

* as.list for theme elements

* move methods

* as.list/convert for other classes

* reformat

* list to theme element conversion

* add tests

* add news bullet

Author: teunbrand

NEWS.md

@@ -1,5 +1,7 @@
 # ggplot2 (development version)
 
+* Implemented `as.list()` and `S7::convert()` methods for lists and classes in ggplot2 
+  (@teunbrand, #6695)
 * The default linetype in `geom_sf()` is derived from `geom_polygon()` for 
   polygons and from `geom_line()` for (multi)linestrings (@teunbrand, #6543).
 * Using infinite `radius` aesthetic in `geom_spoke()` now throws a warning 

R/all-classes.R

@@ -412,3 +412,34 @@ class_ggplot_built <- S7::new_class(
     )
   }
 )
+
+# Methods -----------------------------------------------------------------
+
+#' @importFrom S7 convert
+# S7 currently attaches the S3 method to the calling environment which gives `ggplot2:::as.list`
+# Wrap in `local()` to provide a temp environment which throws away the attachment
+local({
+  list_classes <- class_mapping | class_theme | class_labels
+  prop_classes <- class_ggplot | class_ggplot_built
+
+  S7::method(convert, list(from = prop_classes, to = S7::class_list)) <-
+    function(from, to, ...) S7::props(from)
+
+  S7::method(convert, list(from = list_classes, to = S7::class_list)) <-
+    function(from, to, ...) S7::S7_data(from)
+
+  # We're not using union classes here because of S7#510
+  S7::method(as.list, class_gg) <-
+    S7::method(as.list, class_mapping) <-
+    S7::method(as.list, class_theme) <-
+    S7::method(as.list, class_labels) <-
+    function(x, ...) convert(x, S7::class_list)
+
+  S7::method(convert, list(from = S7::class_list, to = prop_classes)) <-
+    function(from, to, ...) inject(to(!!!from))
+
+  S7::method(convert, list(from = S7::class_list, to = list_classes)) <-
+    function(from, to, ...) to(from)
+})
+
+

R/plot.R

@@ -267,16 +267,3 @@ local({
 
 #' @export
 `[[<-.ggplot2::gg` <- `$<-.ggplot2::gg`
-
-#' @importFrom S7 convert
-# S7 currently attaches the S3 method to the calling environment which gives `ggplot2:::as.list`
-# Wrap in `local()` to provide a temp environment which throws away the attachment
-local({
-  S7::method(convert, list(from = class_ggplot, to = S7::class_list)) <-
-    function(from, to) {
-      S7::props(from)
-    }
-
-  S7::method(as.list, class_ggplot) <-
-    function(x, ...) convert(x, S7::class_list)
-})

R/theme-elements.R

@@ -408,6 +408,29 @@ local({
     deprecate("4.1.0", I("`<ggplot2::element>[[i]]`"), I("`S7::prop(<ggplot2::element>, i)`"))
     `[[`(S7::props(x), i)
   }
+  S7::method(as.list, element) <- function(x, ...) {
+    S7::convert(x, S7::class_list)
+  }
+  S7::method(convert, list(from = element, to = S7::class_list)) <-
+    function(from, to, ...) S7::props(from)
+  S7::method(
+    convert,
+    list(
+      from = S7::class_list,
+      to = element_geom | element_line | element_point |
+        element_polygon | element_rect | element_text | element_blank
+    )
+  ) <- function(from, to, ...) {
+    extra <- setdiff(names(from), fn_fmls_names(to))
+    if (length(extra) > 0) {
+      cli::cli_warn(
+        "Unknown {cli::qty(extra)} argument{?s} to {.fn {to@name}}: \\
+        {.and {.arg {extra}}}."
+      )
+      from <- from[setdiff(names(from), extra)]
+    }
+    inject(to(!!!from))
+  }
 })
 
 # Element setter methods

tests/testthat/_snaps/theme.md

@@ -54,3 +54,7 @@
     The `options('ggplot2.discrete.colour')` setting is incompatible with the `palette.colour.discrete` theme setting.
     i You can set `options(ggplot2.discrete.colour = NULL)`.
 
+# theme element conversion to lists works
+
+    Unknown arguments to `element_text()`: `italic`, `fontweight`, and `fontwidth`.
+

tests/testthat/test-theme.R

@@ -428,6 +428,22 @@ test_that("theme() warns about conflicting palette options", {
   )
 })
 
+test_that("theme element conversion to lists works", {
+
+  x <- element_rect(colour = "red")
+  expect_type(x <- as.list(x), "list")
+  expect_s7_class(convert(x, element_rect), element_rect)
+
+  # For now, element_text doesn't round-trip.
+  # Once fontwidth/fontweight/italic are implemented, it should round-trip again
+  x <- as.list(element_text(colour = "red"))
+  expect_snapshot_warning(
+    convert(x, element_text)
+  )
+  x <- x[setdiff(names(x), c("fontwidth", "fontweight", "italic"))]
+  expect_silent(convert(x, element_text))
+})
+
 # Visual tests ------------------------------------------------------------
 
 test_that("aspect ratio is honored", {

tests/testthat/test-utilities.R

@@ -207,3 +207,24 @@ test_that("compute_data_size handles gnarly cases", {
   new <- compute_data_size(df, size = NULL, target = "width", default = 1)
   expect_all_equal(new$width, 2)
 })
+
+test_that("list conversion works for ggplot classes", {
+  # Test list-based class round-trips
+  x <- aes(x = 10, y = foo)
+  expect_type(x <- as.list(x), "list")
+  expect_s7_class(x <- convert(x, class_mapping), class_mapping)
+
+  # Mapping should still be able to evaluate
+  expect_equal(
+    eval_aesthetics(x, data = data.frame(foo = "A")),
+    list(x = 10, y = "A")
+  )
+
+  # Test property-based class round-trips
+  x <- ggplot()
+  expect_type(x <- as.list(x), "list")
+  expect_s7_class(x <- convert(x, class_ggplot), class_ggplot)
+
+  # Plot should still be buildable
+  expect_s3_class(ggplotGrob(x), "gtable")
+})