as.list() methods for S7 classes

R/all-classes.R

@@ -408,3 +408,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_soft0("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

@@ -153,3 +153,7 @@
       [23] "axis.line.r"                   "complete"                     
       [25] "validate"                     
 
+# theme element conversion to lists works
+
+    Unknown arguments to `element_text()`: `italic`, `fontweight`, and `fontwidth`.
+

tests/testthat/test-theme.R

@@ -791,6 +791,22 @@ test_that("theme elements are covered in `theme_sub_*()` functions", {
   expect_snapshot(extra_elements)
 })
 
+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("element_polygon() can render a grob", {

tests/testthat/test-utilities.R

@@ -218,3 +218,24 @@ test_that("summary method gives a nice summary", {
 
   expect_snapshot(summary(p))
 })
+
+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")
+})