convert labels to S7

Author: teunbrand

NAMESPACE

@@ -64,7 +64,6 @@ S3method(ggplot_add,Scale)
 S3method(ggplot_add,by)
 S3method(ggplot_add,data.frame)
 S3method(ggplot_add,default)
-S3method(ggplot_add,labels)
 S3method(ggplot_add,list)
 S3method(ggplot_build,ggplot)
 S3method(ggplot_build,ggplot_built)

R/labels.R

@@ -175,22 +175,24 @@ setup_plot_labels <- function(plot, layers, data) {
 #' p +
 #'  labs(title = "title") +
 #'  labs(title = NULL)
-labs <- function(..., title = waiver(), subtitle = waiver(), caption = waiver(),
-                 tag = waiver(), dictionary = waiver(), alt = waiver(),
-                 alt_insight = waiver()) {
-  # .ignore_empty = "all" is needed to allow trailing commas, which is NOT a trailing comma for dots_list() as it's in ...
-  args <- dots_list(..., title = title, subtitle = subtitle, caption = caption,
-    tag = tag, alt = allow_lambda(alt), alt_insight = alt_insight,
-    dictionary = dictionary, .ignore_empty = "all")
+labs <- S7::new_class(
+  "labels", parent = S7::new_S3_class("gg"),
+  constructor = function(..., title = waiver(), subtitle = waiver(),
+                         caption = waiver(), tag = waiver(), dictionary = waiver(),
+                         alt = waiver(), alt_insight = waiver()) {
+    # .ignore_empty = "all" is needed to allow trailing commas, which is NOT a trailing comma for dots_list() as it's in ...
+    args <- dots_list(..., title = title, subtitle = subtitle, caption = caption,
+                      tag = tag, alt = allow_lambda(alt), alt_insight = alt_insight,
+                      dictionary = dictionary, .ignore_empty = "all")
 
-  is_waive <- vapply(args, is.waiver, logical(1))
-  args <- args[!is_waive]
-  # remove duplicated arguments
-  args <- args[!duplicated(names(args))]
-  args <- rename_aes(args)
-
-  structure(args, class = c("labels", "gg"))
-}
+    is_waive <- vapply(args, is.waiver, logical(1))
+    args <- args[!is_waive]
+    # remove duplicated arguments
+    args <- args[!duplicated(names(args))]
+    args <- rename_aes(args)
+    S7::new_object(args)
+  }
+)
 
 #' @rdname labs
 #' @export

R/plot-construction.R

@@ -139,8 +139,7 @@ ggplot_add.Scale <- function(object, plot, object_name) {
   plot$scales$add(object)
   plot
 }
-#' @export
-ggplot_add.labels <- function(object, plot, object_name) {
+S7::method(ggplot_add, labs) <- function(object, plot, object_name) {
   update_labels(plot, object)
 }
 #' @export

tests/testthat/test-labels.R

@@ -25,16 +25,16 @@ test_that("setting guide labels works", {
     expect_identical(labs(color = "my label")$colour, "my label")
 
     # No extra elements exists
-    expect_equal(labs(title = "my title"),  list(title = "my title"),  ignore_attr = TRUE)   # formal argument
-    expect_equal(labs(colour = "my label"), list(colour = "my label"), ignore_attr = TRUE)   # dot
-    expect_equal(labs(foo = "bar"),         list(foo = "bar"),         ignore_attr = TRUE)   # non-existent param
+    expect_length(labs(title = "my title"),  1)   # formal argument
+    expect_length(labs(colour = "my label"), 1)   # dot
+    expect_length(labs(foo = "bar"), 1)   # non-existent param
 
     # labs() has list-splicing semantics
     params <- list(title = "my title", tag = "A)")
     expect_identical(labs(!!!params)$tag, "A)")
 
     # NULL is preserved
-    expect_equal(labs(title = NULL), list(title = NULL), ignore_attr = TRUE)
+    expect_length(labs(title = NULL), 1)
 
     # ggtitle works in the same way as labs()
     expect_identical(ggtitle("my title")$title, "my title")