Add ggplot_args_linter: pipe data into ggplot(), aes() as its own layer

lms/NAMESPACE

@@ -4,5 +4,6 @@ export(bare_condition_linter)
 export(default_linters)
 export(function_length_linter)
 export(function_location_linter)
+export(ggplot_args_linter)
 export(nested_call_linter)
 export(undesirable_functions)

lms/R/default_linters.R

@@ -9,8 +9,9 @@
 #' exclusions <- list(...)   # repo-specific, stays local
 #' ```
 #'
-#' @param nested_calls Whether to include [nested_call_linter()] and
-#'   [bare_condition_linter()], the no-nested-calls policy. Off by default
+#' @param nested_calls Whether to include [nested_call_linter()],
+#'   [bare_condition_linter()] and [ggplot_args_linter()],
+#'   the no-nested-calls policy. Off by default
 #'   while existing code is swept; turn them on in a repo's `.lintr.R` with
 #'   `lms::default_linters(nested_calls = TRUE)`.
 #' @return A list of linters, as produced by
@@ -39,7 +40,8 @@ default_linters <- function(nested_calls = FALSE) {
       linters,
       list(
         nested_call_linter = nested_call_linter(),
-        bare_condition_linter = bare_condition_linter()
+        bare_condition_linter = bare_condition_linter(),
+        ggplot_args_linter = ggplot_args_linter()
       )
     )
   }

lms/R/ggplot_args_linter.R

@@ -0,0 +1,58 @@
+#' ggplot() arguments linter
+#'
+#' Flags any argument passed to `ggplot()`.
+#' Pipe the primary data into a bare `ggplot()` layer,
+#' then add the aesthetic mapping as its own layer:
+#' `df |> ggplot() + aes(x, y)`, not `ggplot(df, aes(x, y))`
+#' and not `ggplot(data = df)`.
+#' This is the no-nested-calls policy applied to `ggplot()`,
+#' which [nested_call_linter()] does not enforce
+#' because it allows `aes()` as an argument.
+#'
+#' Both `ggplot()` and `ggplot2::ggplot()` are checked,
+#' and arguments may be named (`data = df`, `mapping = aes(x, y)`)
+#' or positional.
+#' An `aes()` inside a layer such as `geom_point(aes(color = g))`
+#' is not flagged.
+#'
+#' @return A [lintr::Linter()] object.
+#' @export
+ggplot_args_linter <- function() {
+  ggplot_call <- "//expr[expr[1]/SYMBOL_FUNCTION_CALL[text() = 'ggplot']]"
+  is_aes <- "expr[1]/SYMBOL_FUNCTION_CALL[text() = 'aes']"
+  aes_xpath <- paste0(ggplot_call, "/expr[position() > 1][", is_aes, "]")
+  data_xpath <- paste0(ggplot_call, "/expr[position() > 1][not(", is_aes, ")]")
+
+  aes_message <- paste(
+    "Don't nest aes() inside ggplot(): pipe the data into ggplot()",
+    "and add the mapping as its own layer (`+ aes(x, y)`)."
+  )
+  data_message <- paste(
+    "Don't pass data to ggplot(): pipe the primary data into a bare",
+    "ggplot() (`df |> ggplot() + aes(x, y)`)."
+  )
+
+  lintr::Linter(function(source_expression) {
+    if (!lintr::is_lint_level(source_expression, "expression")) {
+      return(list())
+    }
+
+    xml <- source_expression$xml_parsed_content
+    aes_nodes <- xml2::xml_find_all(xml, aes_xpath)
+    data_nodes <- xml2::xml_find_all(xml, data_xpath)
+
+    aes_lints <- lintr::xml_nodes_to_lints(
+      aes_nodes,
+      source_expression = source_expression,
+      lint_message = aes_message,
+      type = "warning"
+    )
+    data_lints <- lintr::xml_nodes_to_lints(
+      data_nodes,
+      source_expression = source_expression,
+      lint_message = data_message,
+      type = "warning"
+    )
+    c(aes_lints, data_lints)
+  })
+}

lms/README.md

@@ -32,7 +32,9 @@ It exports:
   and for tidyselect helpers, `aes()` and `vars()`, it flags nothing.
   The second flags an `if()` or `while()` condition that is not already a bare name or `TRUE`/`FALSE`,
   as in `while (TRUE)`.
-  Both are off by default while existing code is swept;
+  `ggplot_args_linter()` is the third: it flags any argument of `ggplot()` (`aes()` or the data),
+  so pipe the data into a bare `ggplot()` and add the mapping as its own layer (`df |> ggplot() + aes(x, y)`).
+  All three are off by default while existing code is swept;
   turn them on with `lms::default_linters(nested_calls = TRUE)`.
 - `undesirable_functions()` --- the underlying undesirable-function map,
   if a repo needs to extend it.

lms/tests/testthat/test-ggplot_args_linter.R

@@ -0,0 +1,80 @@
+aes_message <- "Don't nest aes\\(\\) inside ggplot\\(\\)"
+data_message <- "Don't pass data to ggplot\\(\\)"
+
+test_that("aes() inside ggplot() is flagged", {
+  lintr::expect_lint(
+    "ggplot(aes(x, y))",
+    aes_message,
+    ggplot_args_linter()
+  )
+  lintr::expect_lint(
+    "ggplot2::ggplot(ggplot2::aes(x, y))",
+    aes_message,
+    ggplot_args_linter()
+  )
+  lintr::expect_lint(
+    "ggplot(mapping = aes(x, y))",
+    aes_message,
+    ggplot_args_linter()
+  )
+  lintr::expect_lint(
+    "df |> ggplot2::ggplot(ggplot2::aes(x, y))",
+    aes_message,
+    ggplot_args_linter()
+  )
+})
+
+test_that("data passed to ggplot() is flagged", {
+  lintr::expect_lint("ggplot(df)", data_message, ggplot_args_linter())
+  lintr::expect_lint(
+    "ggplot(data = df)",
+    data_message,
+    ggplot_args_linter()
+  )
+  lintr::expect_lint(
+    "ggplot2::ggplot(df) + aes(x, y)",
+    data_message,
+    ggplot_args_linter()
+  )
+  lintr::expect_lint(
+    "ggplot(read_csv(path))",
+    data_message,
+    ggplot_args_linter()
+  )
+})
+
+test_that("data and mapping together give one lint each", {
+  lints <- lintr::lint(
+    text = "ggplot(df, aes(x, y))",
+    linters = list(ggplot_args_linter = ggplot_args_linter())
+  )
+  messages <- vapply(lints, function(lint) lint$message, character(1))
+  expect_match(messages[1], data_message)
+  expect_match(messages[2], aes_message)
+  expect_length(lints, 2)
+})
+
+test_that("the piped form with aes() as its own layer is not flagged", {
+  lintr::expect_no_lint(
+    "df |> ggplot2::ggplot() + ggplot2::aes(x, y)",
+    ggplot_args_linter()
+  )
+  lintr::expect_no_lint("ggplot()", ggplot_args_linter())
+})
+
+test_that("aes() inside a layer is not flagged", {
+  lintr::expect_no_lint(
+    "df |> ggplot() + aes(x, y) + geom_point(aes(colour = g))",
+    ggplot_args_linter()
+  )
+  lintr::expect_no_lint(
+    "ggplot2::geom_point(ggplot2::aes(colour = g))",
+    ggplot_args_linter()
+  )
+})
+
+test_that("default_linters(nested_calls = TRUE) includes it", {
+  linters <- default_linters(nested_calls = TRUE)
+  expect_true("ggplot_args_linter" %in% names(linters))
+  expect_false("ggplot_args_linter" %in% names(default_linters()))
+})