write boilerplate function

Author: teunbrand

DESCRIPTION

@@ -108,6 +108,9 @@ Collate:
     'backports.R'
     'bench.R'
     'bin.R'
+    'scale-type.R'
+    'layer.R'
+    'boilerplates.R'
     'coord-.R'
     'coord-cartesian-.R'
     'coord-fixed.R'
@@ -186,7 +189,6 @@ Collate:
     'guide-colorbar.R'
     'guide-colorsteps.R'
     'guide-custom.R'
-    'layer.R'
     'guide-none.R'
     'guide-old.R'
     'guides-.R'
@@ -236,7 +238,6 @@ Collate:
     'scale-shape.R'
     'scale-size.R'
     'scale-steps.R'
-    'scale-type.R'
     'scale-view.R'
     'scale-viridis.R'
     'scales-.R'

R/boilerplates.R

@@ -0,0 +1,64 @@
+#' @include layer.R
+#' @include scale-type.R
+NULL
+
+#' @export
+boilerplate <- function(x, ...) {
+  UseMethod("boilerplate")
+}
+
+#' @export
+boilerplate.Geom <- function(x, ..., env = caller_env()) {
+
+  # Check that we can independently find the geom
+  geom <- gsub("^geom_", "", snake_class(x))
+  check_subclass(geom, "Geom", env = env)
+
+  # Split additional arguments into required and extra ones
+  args <- enexprs(...)
+  fixed_fmls_names <- c("mapping", "data", "stat", "position", "...",
+                        "na.rm", "show.legend", "inherit.aes")
+  extra_args <- setdiff(names(args), fixed_fmls_names)
+  if ("geom" %in% extra_args) {
+    cli::cli_abort("{.arg geom} is a reserved argument.")
+  }
+
+  # Build function formals
+  fmls <- list2(
+    mapping  = args$mapping,
+    data     = args$data,
+    stat     = args$stat %||% "identity",
+    position = args$position %||% "identity",
+    `...` = quote(expr = ),
+    !!!args[extra_args],
+    na.rm    = args$na.rm %||% FALSE,
+    show.legend = args$show.legend %||% NA,
+    inherit.aes = args$inherit.aes %||% TRUE
+  )
+
+  if (length(extra_args) > 0) {
+    extra_args <- paste0(
+      "\n      ", extra_args, " = ", extra_args, ",", collapse = ""
+    )
+  }
+
+  body <- paste0("
+  layer(
+    data = data,
+    mapping = mapping,
+    stat = stat,
+    geom = \"", geom, "\",
+    position = position,
+    show.legend = show.legend,
+    inherit.aes = inherit.aes,
+    params = list2(
+      na.rm = na.rm,",
+      extra_args, "
+      ...
+    )
+  )
+  ")
+  body <- as.call(parse(text = body))[[1]]
+
+  new_function(fmls, body)
+}