Incorporate latest ggplot2 class renaming

in tidyverse/ggplot2#6546

Author: mrcaseb

NAMESPACE

@@ -30,8 +30,8 @@ export(valid_team_names)
 import(data.table)
 import(grid)
 importFrom(ggpath,element_path)
-importFrom(ggplot2,draw_element)
 importFrom(ggplot2,element)
+importFrom(ggplot2,element_grob)
 importFrom(graphics,par)
 importFrom(lifecycle,deprecated)
 importFrom(nflreadr,nflverse_sitrep)

R/nflplotR-package.R

@@ -6,7 +6,7 @@
 ## usethis namespace: start
 #' @import data.table
 #' @import grid
-#' @importFrom ggplot2 draw_element element
+#' @importFrom ggplot2 element_grob element
 #' @importFrom graphics par
 #' @importFrom lifecycle deprecated
 #' @importFrom rlang .data %||%

R/theme-elements.R

@@ -147,7 +147,7 @@ element_nfl_headshot <- S7::new_class(
 #' @importFrom ggpath element_path
 ggpath::element_path
 
-S7::method(draw_element, element_nfl_logo) <- function(
+S7::method(element_grob, element_nfl_logo) <- function(
   element,
   label = "",
   x = NULL,
@@ -171,22 +171,47 @@ S7::method(draw_element, element_nfl_logo) <- function(
     )
   }
 
-  S7::method(draw_element, ggpath::element_path)(
+  # This will likely break in a future ggplot2 release as they
+  # currently work with a weird mix of S3 and S7. element_grob is a S3 generic
+  # but the methods are S7. However, I can't call the method from ggpath with
+  # S7::method(element_grob, ggpath::element_path)(...)
+  # I think this should work and probably will work at some point in the future
+  # in the meantime I change the class of element to dispatch to the ggpath
+  # method for further processing.
+  class(element) <- c(
+    "ggpath::element_path",
+    "ggplot2::element_text",
+    "ggplot2::element",
+    "S7_object"
+  )
+
+  ggplot2::element_grob(
     element = element,
     label = image_list,
     x = x,
     y = y
   )
 }
 
-S7::method(draw_element, element_nfl_wordmark) <- function(
+S7::method(element_grob, element_nfl_wordmark) <- function(
   element,
   label = "",
   x = NULL,
   y = NULL,
   ...
 ) {
-  S7::method(draw_element, element_nfl_logo)(
+  # see comment on weird S3/S7 mix in the above method
+  # Note that I dispatch to the nflplotR method here before we move on
+  # to ggpath
+  class(element) <- c(
+    "nflplotR::element_nfl_logo",
+    "ggpath::element_path",
+    "ggplot2::element_text",
+    "ggplot2::element",
+    "S7_object"
+  )
+
+  ggplot2::element_grob(
     element = element,
     label = label,
     x = x,
@@ -196,7 +221,7 @@ S7::method(draw_element, element_nfl_wordmark) <- function(
   )
 }
 
-S7::method(draw_element, element_nfl_headshot) <- function(
+S7::method(element_grob, element_nfl_headshot) <- function(
   element,
   label = "",
   x = NULL,
@@ -217,7 +242,15 @@ S7::method(draw_element, element_nfl_headshot) <- function(
     image_urls[is.na(image_urls)] <- na_headshot()
   }
 
-  S7::method(draw_element, ggpath::element_path)(
+  # see comment on weird S3/S7 mix in the above method
+  class(element) <- c(
+    "ggpath::element_path",
+    "ggplot2::element_text",
+    "ggplot2::element",
+    "S7_object"
+  )
+
+  ggplot2::element_grob(
     element = element,
     label = image_urls,
     x = x,

tests/testthat/_snaps/theme-elements.md

@@ -1,10 +1,7 @@
 # logo element works
 
     Code
-      out <- ggplotGrob(p3)
-    Message
-      ! Can't find team abbreviation "LARRR". Will insert empty graphic object.
-      ! Can't find team abbreviation "LARRR". Will insert empty graphic object.
+      out <- ggplot2::ggplot_build(p3)
 
 ---
 

tests/testthat/test-theme-elements.R

@@ -35,7 +35,7 @@ test_that("logo element works", {
     theme(
       strip.text = element_nfl_wordmark()
     )
-  expect_snapshot(out <- ggplotGrob(p3))
+  expect_snapshot(out <- ggplot2::ggplot_build(p3))
 
   # GSIS ID mismatch
   p4 <- data.frame(a = c("00-0033077", "00-0012345"), b = 1:2, c = 10:11) |>