temporary fix for plot layer

BristolMyersSquibb · May 31, 2024 · 1981fb8 · 1981fb8
1 parent 56e4757
commit 1981fb8
Show file tree

Hide file tree

Showing 3 changed files with 15 additions and 21 deletions.
diff --git a/R/block-core.R b/R/block-core.R
@@ -249,6 +249,7 @@ evaluate_block.plot_layer_block <- function(x, data, ...) {
 
   stopifnot(...length() == 0L)
 
+  if (!inherits(data, "ggplot")) return(NULL)
   eval(
     substitute(data + expr, list(expr = generate_code(x))),
     list(data = data)

diff --git a/tests/testthat/test-block.R b/tests/testthat/test-block.R
@@ -401,7 +401,7 @@ test_that("block demo works", {
   skip_on_cran()
 
   # Helper plot blocks
-  new_ggplot_block <- function(data, ...) {
+  new_ggplot_block <- function(...) {
     data_cols <- function(data) colnames(data)
 
     new_block(
@@ -415,11 +415,10 @@ test_that("block demo works", {
     )
   }
 
-  ggplot_block <- function(data, ...) {
-    initialize_block(new_ggplot_block(data, ...), data)
-  }
-
-  new_geompoint_block <- function(data, ...) {
+  new_geompoint_block <- function(...) {
+    plop <- function(data) {
+      browser()
+    }
     new_block(
       fields = list(
         color = new_select_field("blue", c("blue", "green", "red"))
@@ -430,24 +429,17 @@ test_that("block demo works", {
     )
   }
 
-  geompoint_block <- function(data, ...) {
-    initialize_block(new_geompoint_block(data, ...), data)
-  }
-
   custom_data_block <- function(...) {
-    initialize_block(
-      new_dataset_block(
-        dat = as.environment("package:datasets"),
-        selected = "airquality",
-        ...
-      )
+    new_dataset_block(
+      selected = "airquality",
+      ...
     )
   }
 
   stack <- new_stack(
     custom_data_block,
-    ggplot_block,
-    geompoint_block
+    new_ggplot_block,
+    new_geompoint_block
   )
 
   # Change block ids to known values

diff --git a/tests/testthat/test-mutate-block.R b/tests/testthat/test-mutate-block.R
@@ -26,8 +26,8 @@ test_that("mutate_module_server handles input correctly", {
 
   # wrap generate_server
   # id as first argument, so we can test via shiny::testSever
-  module_server_test <- function(id, x, in_dat, ...) {
-    generate_server(x = x, in_dat = in_dat, id = id)
+  module_server_test <- function(id, x, in_dat, is_prev_valid, ...) {
+    generate_server(x = x, in_dat = in_dat, id = id, is_prev_valid = is_prev_valid)
   }
 
   shiny::testServer(
@@ -48,7 +48,8 @@ test_that("mutate_module_server handles input correctly", {
     args = list(
       id = "test",
       x = new_mutate_block(data = datasets::iris),
-      in_dat = reactive(datasets::iris)
+      in_dat = reactive(datasets::iris),
+      is_prev_valid = TRUE
     )
   )
 })