Handle from_theme(foo %||% NA) properly and fix tests

NEWS.md

@@ -7,6 +7,8 @@
 * Fix a bug about handling Geoms that have some non-primitive value as a default
   for an aesthetic (#195).
 
+* Treat `from_theme(foo %||% NA)` as `NA` (#216).
+
 * `gghighlight_point()` and `gghighlight_line()` are removed.
 
 # gghighlight 0.4.1

R/gghighlight.R

@@ -557,8 +557,10 @@ get_default_aes_param <- function(
   if (
     aes_param_name %in%
       names(non_null_default_aes) &&
-      # is.na() cannot handle non primitive objects (e.g. a quosure)
-      rlang::is_na(non_null_default_aes[[aes_param_name]])
+      # check if
+      #   - x is NA
+      #   - x is quo(from_theme(foo %|% NA))
+      is_na_aes(non_null_default_aes[[aes_param_name]])
   ) {
     return(NA)
   }

R/util.R

@@ -42,3 +42,43 @@ make_label <- function(x) {
   }
   name
 }
+
+# return TRUE if
+#   - x is NA
+#   - x is quo(from_theme(foo %|% NA))
+is_na_aes <- function(x) {
+  if (is_na(x)) {
+    return(TRUE)
+  }
+
+  # if X is not NA, inspect inside the quosure
+
+  if (!is_quosure(x)) {
+    return(FALSE)
+  }
+
+  x <- quo_squash(x)
+  if (is_na(x)) {
+    return(TRUE)
+  }
+
+  if (!is_call(x) || call_name(x) != "from_theme") {
+    return(FALSE)
+  }
+
+  args <- call_args(x)
+
+  if (
+    length(args) == 1L && !is_call(args[[1]]) || call_name(args[[1]]) != "%||%"
+  ) {
+    return(FALSE)
+  }
+
+  args_inner <- call_args(args[[1]])
+
+  if (length(args_inner) != 2L) {
+    return(FALSE)
+  }
+
+  is_na(args_inner[[2]])
+}

tests/testthat/helpers.R

@@ -3,6 +3,9 @@ expect_equal_layer <- function(x, y) {
   x$constructor <- NULL
   y$constructor <- NULL
 
+  x$computed_mapping <- NULL
+  y$computed_mapping <- NULL
+
   x$aes_params <- x$aes_params[sort(names(x$aes_params))]
   y$aes_params <- y$aes_params[sort(names(y$aes_params))]
   x$mapping <- x$mapping[sort(names(x$mapping))]
@@ -17,10 +20,19 @@ expect_equal_layer <- function(x, y) {
 }
 
 as_no_label_list <- function(x) {
-  lapply(x, \(x) {
+  x <- lapply(x, \(x) {
     attr(x, "label") <- NULL
     x
   })
+
+  if (!is.null(x$data)) {
+    x$data <- lapply(x$data, \(x) {
+      attr(x, "label") <- NULL
+      x
+    })
+  }
+
+  x
 }
 
 expect_equal_layers <- function(x, y) {

tests/testthat/test-bleach.R

@@ -47,10 +47,10 @@ test_that("bleach_layer() works", {
     geom_line(aes(colour = NULL, fill = NULL), d, colour = grey07)
   )
 
-  # If the geom accepts fill, it is sets to grey even when it is not included in the mapping.
+  # If the geom accepts fill, it is set to grey even when it is not included in the mapping.
   expect_equal_layer(
     bleach_layer(geom_col(aes(colour = type), d), g_info, list()),
-    geom_col(aes_bleached, d_bleached, colour = grey07, fill = grey07)
+    geom_col(aes_bleached, d_bleached, colour = NA, fill = grey07)
   )
 
   # If the default of colour of the geom is NA and mapping doesn't specify it, params will be NA.
@@ -62,7 +62,7 @@ test_that("bleach_layer() works", {
   # If colour and fill is specified at the same time, fill is used as the group key.
   expect_equal_layer(
     bleach_layer(geom_col(aes(colour = type, fill = type), d), g_info, list()),
-    geom_col(aes_bleached, d_bleached, colour = grey07, fill = grey07)
+    geom_col(aes_bleached, d_bleached, colour = NA, fill = grey07)
   )
 
   # If mapping doesn't have colour or fill, group or x aes can be used as group key.

tests/testthat/test-gghighlight.R

@@ -184,7 +184,7 @@ test_that("gghighlight() works with two layers, grouped", {
     d_bleached2,
     shape = "circle filled",
     colour = grey07,
-    fill = grey07
+    fill = NA
   )
   l_sieved_2 <- geom_point(
     aes(x, y, colour = type, fill = type),

tests/testthat/test-internals.R

@@ -71,3 +71,14 @@ test_that("get_facet_vars() extract facet specs", {
   class(p$facet) <- c("FacetUnknown", class(p$facet))
   expect_error(get_facet_vars(p$facet))
 })
+
+test_that("is_na_aes() works", {
+  expect_true(is_na_aes(NA))
+  expect_true(is_na_aes(quo(NA)))
+  expect_true(is_na_aes(quo(from_theme(foo %||% NA))))
+  expect_true(is_na_aes(quo(from_theme(foo %||% NA_character_))))
+
+  expect_false(is_na_aes(quo(foo)))
+  expect_false(is_na_aes(quo(from_theme(foo))))
+  expect_false(is_na_aes(quo(from_theme(foo %||% 1))))
+})