Add layer_sf() constructor. Closes tidyverse#3232.

NAMESPACE

@@ -379,6 +379,7 @@ export(layer)
 export(layer_data)
 export(layer_grob)
 export(layer_scales)
+export(layer_sf)
 export(lims)
 export(map_data)
 export(margin)

NEWS.md

@@ -44,6 +44,10 @@ core developer team.
   creation of custom layers that autogenerate aesthetic mappings based on the 
   input data or that filter the input data in some form. This is mainly of 
   interest to extension developers (@clauswilke, #2872).
+
+* A new layer type `layer_sf()` can auto-detect and auto-map sf geometry
+  columns in the data. It should be used by extension developers who are writing
+  new sf-based geoms or stats (@clauswilke, #3232).
 
 * `x0` and `y0` are now recognized positional aesthetics so they will get scaled 
   if used in extension geoms and stats (@thomasp85, #3168)

R/geom-sf.R

@@ -170,7 +170,7 @@ geom_sf <- function(mapping = aes(), data = NULL, stat = "sf",
                     position = "identity", na.rm = FALSE, show.legend = NA,
                     inherit.aes = TRUE, ...) {
   c(
-    layer(
+    layer_sf(
       geom = GeomSf,
       data = data,
       mapping = mapping,
@@ -182,8 +182,7 @@ geom_sf <- function(mapping = aes(), data = NULL, stat = "sf",
         na.rm = na.rm,
         legend = if (is.character(show.legend)) show.legend else "polygon",
         ...
-      ),
-      layer_class = LayerSf
+      )
     ),
     coord_sf(default = TRUE)
   )
@@ -215,7 +214,7 @@ geom_sf_label <- function(mapping = aes(), data = NULL,
     position <- position_nudge(nudge_x, nudge_y)
   }
 
-  layer(
+  layer_sf(
     data = data,
     mapping = mapping,
     stat = stat,
@@ -231,8 +230,7 @@ geom_sf_label <- function(mapping = aes(), data = NULL,
       na.rm = na.rm,
       fun.geometry = fun.geometry,
       ...
-    ),
-    layer_class = LayerSf
+    )
   )
 }
 
@@ -260,7 +258,7 @@ geom_sf_text <- function(mapping = aes(), data = NULL,
     position <- position_nudge(nudge_x, nudge_y)
   }
 
-  layer(
+  layer_sf(
     data = data,
     mapping = mapping,
     stat = stat,
@@ -274,8 +272,7 @@ geom_sf_text <- function(mapping = aes(), data = NULL,
       na.rm = na.rm,
       fun.geometry = fun.geometry,
       ...
-    ),
-    layer_class = LayerSf
+    )
   )
 }
 

R/layer-sf.R

@@ -1,6 +1,25 @@
+#' Create a new sf layer that auto-maps geometry data
+#'
+#' The `layer_sf()` function is a variant of [`layer()`] meant to be used by
+#' extension developers who are writing new sf-based geoms or stats.
+#' The sf layer checks whether the data contains a geometry column, and
+#' if one is found it is automatically mapped to the `geomtry` aesthetic.
 #' @include layer.r
-
-# A special sf layer that auto-maps geometry data to the `geometry` aesthetic
+#' @inheritParams layer
+#' @keywords internal
+#' @export
+layer_sf <- function(geom = NULL, stat = NULL,
+                     data = NULL, mapping = NULL,
+                     position = NULL, params = list(),
+                     inherit.aes = TRUE, check.aes = TRUE, check.param = TRUE,
+                     show.legend = NA) {
+  layer(
+    geom = geom, stat = stat, data = data, mapping = mapping,
+    position = position, params = params, inherit.aes = inherit.aes,
+    check.aes = check.aes, check.param = check.param,
+    show.legend = show.legend, layer_class = LayerSf
+  )
+}
 
 LayerSf <- ggproto("LayerSf", Layer,
   setup_layer = function(self, data, plot) {

R/stat-sf-coordinates.R

@@ -62,7 +62,7 @@ stat_sf_coordinates <- function(mapping = aes(), data = NULL, geom = "point",
                                 show.legend = NA, inherit.aes = TRUE,
                                 fun.geometry = NULL,
                                 ...) {
-  layer(
+  layer_sf(
     stat = StatSfCoordinates,
     data = data,
     mapping = mapping,
@@ -74,8 +74,7 @@ stat_sf_coordinates <- function(mapping = aes(), data = NULL, geom = "point",
       na.rm = na.rm,
       fun.geometry = fun.geometry,
       ...
-    ),
-    layer_class = LayerSf
+    )
   )
 }
 

R/stat-sf.R

@@ -22,7 +22,7 @@ StatSf <- ggproto("StatSf", Stat,
 stat_sf <- function(mapping = NULL, data = NULL, geom = "rect",
                     position = "identity", na.rm = FALSE, show.legend = NA,
                     inherit.aes = TRUE, ...) {
-  layer(
+  layer_sf(
     stat = StatSf,
     data = data,
     mapping = mapping,
@@ -34,8 +34,7 @@ stat_sf <- function(mapping = NULL, data = NULL, geom = "rect",
       na.rm = na.rm,
       legend = if (is.character(show.legend)) show.legend else "polygon",
       ...
-    ),
-    layer_class = LayerSf
+    )
   )
 }