allow for passing blocks to new_stack()

R/block-core.R

@@ -247,9 +247,8 @@ evaluate_block.block <- function(x, data, ...) {
 #' @export
 evaluate_block.plot_layer_block <- function(x, data, ...) {
 
-  stopifnot(...length() == 0L)
+  stopifnot(...length() == 0L, inherits(data, "ggplot"))
 
-  if (!inherits(data, "ggplot")) return(NULL)
   eval(
     substitute(data + expr, list(expr = generate_code(x))),
     list(data = data)

R/stack.R

@@ -10,7 +10,7 @@
 #' @export
 new_stack <- function(..., title = "Stack", name = rand_names()) {
 
-  ctors <- c(...)
+  ctors <- list(...)
   names <- names(ctors)
 
   stopifnot(is_string(title), is_string(name))
@@ -19,19 +19,18 @@ new_stack <- function(..., title = "Stack", name = rand_names()) {
 
     blocks <- vector("list", length(ctors))
 
-    blocks[[1L]] <- initialize_block(
-      do.call(ctors[[1L]], list(position = 1))
-    )
+    if (length(names)) {
+      stopifnot(length(unique(names)) == length(blocks))
+    } else {
+      names <- rand_names(n = length(blocks))
+    }
 
+    blocks[[1L]] <- do_init_block(ctors[[1L]], 1L, names[1L])
     temp <- evaluate_block(blocks[[1L]])
 
     for (i in seq_along(ctors)[-1L]) {
 
-      blocks[[i]] <- initialize_block(
-        do.call(ctors[[i]], list(position = i)),
-        temp
-      )
-
+      blocks[[i]] <- do_init_block(ctors[[i]], i, names[i], temp)
       temp <- evaluate_block(blocks[[i]], data = temp)
     }
 
@@ -46,6 +45,25 @@ new_stack <- function(..., title = "Stack", name = rand_names()) {
   structure(blocks, title = title, name = name, result = temp, class = "stack")
 }
 
+do_init_block <- function(x, pos, nme, dat = NULL) {
+
+  if (is.function(x)) {
+    x <- do.call(x, list())
+  }
+
+  stopifnot(inherits(x, "block"))
+
+  # TODO: stop doing this and track info on stack level
+  attr(x, "position") <- pos
+  attr(x, "name") <- nme
+
+  if (is.null(dat)) {
+    initialize_block(x)
+  } else {
+    initialize_block(x, dat)
+  }
+}
+
 set_stack_blocks <- function(stack, blocks, result) {
   stopifnot(is_stack(stack), is.list(blocks), all(lgl_ply(blocks, is_block)))
 

tests/testthat/test-block.R

@@ -372,20 +372,21 @@ test_that("blocks can be constructed with default args", {
   }
 })
 
-library(shinytest2)
-library(ggplot2)
+withr::local_package("shinytest2")
+withr::local_package("ggplot2")
+
 test_that("block demo works", {
   # Don't run these tests on the CRAN build servers
   skip_on_cran()
 
   # Helper plot blocks
-  new_ggplot_block <- function(...) {
+  new_ggplot_block <- function(col_x = character(), col_y = character(), ...) {
     data_cols <- function(data) colnames(data)
 
     new_block(
       fields = list(
-        x = new_select_field(colnames(data)[1], data_cols, type = "name"),
-        y = new_select_field(colnames(data)[2], data_cols, type = "name")
+        x = new_select_field(col_x, data_cols, type = "name"),
+        y = new_select_field(col_y, data_cols, type = "name")
       ),
       expr = quote(ggplot2::ggplot(mapping = ggplot2::aes(x = .(x), y = .(y)))),
       class = c("ggplot_block", "plot_block"),
@@ -404,24 +405,12 @@ test_that("block demo works", {
     )
   }
 
-  custom_data_block <- function(...) {
-    new_dataset_block(
-      selected = "airquality",
-      ...
-    )
-  }
-
   stack <- new_stack(
-    custom_data_block,
-    new_ggplot_block,
-    new_geompoint_block
+    block_1 = new_dataset_block("anscombe"),
+    block_2 = new_ggplot_block("x1", "y1"),
+    block_3 = new_geompoint_block()
   )
 
-  # Change block ids to known values
-  for (i in seq_along(stack)) {
-    attr(stack[[i]], "name") <- sprintf("block_%s", i)
-  }
-
   blocks_app <- serve_stack(stack)
 
   app <- AppDriver$new(