From 3c17dc9f806f53d253ef2f36b2dfe73c94fac69e Mon Sep 17 00:00:00 2001
From: Teun van den Brand <tahvdbrand@gmail.com>
Date: Fri, 20 Sep 2024 16:54:46 +0200
Subject: [PATCH 1/3] add lookup via constructor

---
 R/layer.R | 49 ++++++++++++++++++++++++++++++++++++-------------
 1 file changed, 36 insertions(+), 13 deletions(-)

diff --git a/R/layer.R b/R/layer.R
index 8acb438c9e..61a66a51da 100644
--- a/R/layer.R
+++ b/R/layer.R
@@ -58,8 +58,8 @@
 #'   `NA`, the default, includes if any aesthetics are mapped.
 #'   `FALSE` never includes, and `TRUE` always includes.
 #'   It can also be a named logical vector to finely select the aesthetics to
-#'   display. To include legend keys for all levels, even 
-#'   when no data exists, use `TRUE`.  If `NA`, all levels are shown in legend, 
+#'   display. To include legend keys for all levels, even
+#'   when no data exists, use `TRUE`.  If `NA`, all levels are shown in legend,
 #'   but unobserved levels are omitted.
 #' @param inherit.aes If `FALSE`, overrides the default aesthetics,
 #'   rather than combining with them. This is most useful for helper functions
@@ -475,19 +475,42 @@ check_subclass <- function(x, subclass,
                            env = parent.frame(),
                            call = caller_env()) {
   if (inherits(x, subclass)) {
-    x
-  } else if (is_scalar_character(x)) {
-    name <- paste0(subclass, camelize(x, first = TRUE))
-    obj <- find_global(name, env = env)
-
-    if (is.null(obj) || !inherits(obj, subclass)) {
-      cli::cli_abort("Can't find {argname} called {.val {x}}.", call = call)
-    } else {
-      obj
-    }
-  } else {
+    return(x)
+  }
+  if (!is_scalar_character(x)) {
     stop_input_type(x, as_cli("either a string or a {.cls {subclass}} object"))
   }
+
+  # Try getting class object directly
+  name <- paste0(subclass, camelize(x, first = TRUE))
+  obj <- find_global(name, env = env)
+  if (inherits(obj, subclass)) {
+    return(obj)
+  }
+
+  # Try retrieving class via constructors
+  name <- snakeize(name)
+  obj <- find_global(name, env = env, mode = "function")
+  if (is.function(obj)) {
+    obj <- obj()
+  }
+  # Position constructors return classes directly
+  if (inherits(obj, subclass)) {
+    return(obj)
+  }
+  # Try prying the class from a layer
+  if (inherits(obj, "Layer")) {
+    obj <- switch(
+      subclass,
+      Geom = obj$geom,
+      Stat = obj$stat,
+      NULL
+    )
+  }
+  if (inherits(obj, subclass)) {
+    return(obj)
+  }
+  cli::cli_abort("Can't find {argname} called {.val {x}}.", call = call)
 }
 
 # helper function to adjust the draw_key slot of a geom

From 6ad4e0221a94e8c7d41f18b0eee8406fac9340d2 Mon Sep 17 00:00:00 2001
From: Teun van den Brand <tahvdbrand@gmail.com>
Date: Fri, 20 Sep 2024 16:54:51 +0200
Subject: [PATCH 2/3] add tests

---
 tests/testthat/test-layer.R | 16 ++++++++++++++++
 1 file changed, 16 insertions(+)

diff --git a/tests/testthat/test-layer.R b/tests/testthat/test-layer.R
index 51f0cd9eee..893c061c77 100644
--- a/tests/testthat/test-layer.R
+++ b/tests/testthat/test-layer.R
@@ -160,6 +160,22 @@ test_that("layer names can be resolved", {
   )
 })
 
+test_that("check_subclass can resolve classes via constructors", {
+
+  env <- new_environment(list(
+    geom_foobar = geom_point,
+    stat_foobar = stat_boxplot,
+    position_foobar = position_nudge,
+    guide_foobar = guide_axis_theta
+  ))
+
+  expect_s3_class(check_subclass("foobar", "Geom", env = env), "GeomPoint")
+  expect_s3_class(check_subclass("foobar", "Stat", env = env), "StatBoxplot")
+  expect_s3_class(check_subclass("foobar", "Position", env = env), "PositionNudge")
+  expect_s3_class(check_subclass("foobar", "Guide", env = env), "GuideAxisTheta")
+
+})
+
 
 # Data extraction ---------------------------------------------------------
 

From 206a3c948a2e8508259aeeb207d75af201c3c738 Mon Sep 17 00:00:00 2001
From: Teun van den Brand <tahvdbrand@gmail.com>
Date: Fri, 20 Sep 2024 16:55:44 +0200
Subject: [PATCH 3/3] add news bullet

---
 NEWS.md | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/NEWS.md b/NEWS.md
index 5df6059f0f..e2fdbd6d1e 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,5 +1,7 @@
 # ggplot2 (development version)
 
+* When `check_subclass()` fails to find a class directly, it tries to retrieve
+  the class via constructor functions.
 * Built-in `theme_*()` functions now have `ink` and `paper` arguments to control
   foreground and background colours respectively (@teunbrand)
 * The `summary()` method for ggplots is now more terse about facets