Persist registry ID in block

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: blockr
 Title: A block-based framework for data manipulation and visualization
-Version: 0.0.2.9031
+Version: 0.0.3.9000
 Authors@R: 
     c(person(given = "Nicolas",
              family = "Bennett",
@@ -42,7 +42,8 @@ Imports:
     shinyWidgets
 Remotes:
     DivadNojnarg/DiagrammeR,
-    BristolMyersSquibb/blockr.data
+    BristolMyersSquibb/blockr.data,
+    cynkra/scoutbaR
 Suggests: 
     knitr,
     rmarkdown,
@@ -55,7 +56,8 @@ Suggests:
     ggplot2,
     vdiffr,
     palmerpenguins,
-    blockr.data
+    blockr.data,
+    scoutbaR
 Config/testthat/edition: 3
 VignetteBuilder: knitr
 Depends: 

NAMESPACE

@@ -16,6 +16,15 @@ S3method(block_icon,data_block)
 S3method(block_icon,default)
 S3method(block_icon,plot_block)
 S3method(block_icon,transform_block)
+S3method(block_input_check,data_block)
+S3method(block_input_check,parser_block)
+S3method(block_input_check,result_block)
+S3method(block_input_check,transform_block)
+S3method(block_output_ptype,dataset_block)
+S3method(block_output_ptype,filesbrowser_block)
+S3method(block_output_ptype,result_block)
+S3method(block_output_ptype,transform_block)
+S3method(block_output_ptype,upload_block)
 S3method(blockr_serialize,block)
 S3method(blockr_serialize,field)
 S3method(blockr_serialize,stack)
@@ -148,7 +157,9 @@ export(block_combiner)
 export(block_descr)
 export(block_header)
 export(block_icon)
+export(block_input_check)
 export(block_name)
+export(block_output_ptype)
 export(blockr_deserialize)
 export(blockr_serialize)
 export(cat_logger)
@@ -166,7 +177,6 @@ export(generate_server)
 export(generate_ui)
 export(get_compatible_blocks)
 export(get_field_name)
-export(get_registry)
 export(get_stack_name)
 export(get_stack_title)
 export(get_workspace)
@@ -180,6 +190,7 @@ export(init_lock)
 export(initialize_block)
 export(initialize_field)
 export(inject_remove_button)
+export(input_failure)
 export(input_ids)
 export(is_block)
 export(is_field)

NEWS.md

@@ -1,3 +1,47 @@
+# blockr 0.0.3.9000
+
+## Breaking changes
+- `register_blocks()` and `register_block()` __input__, __output__ have been changed. If your package is composed of __data__ or __transform__ blocks, nothing has to be done, expect removing the old registration API. If you developed custom blocks, whose classes are neither __data__ or __transform__, you'll have to develop a type checker like so, for a plot block:
+
+```r
+block_input_check.plot_block <- function(x, data, ...) {
+
+  if (inherits(data, "data.frame")) {
+    return(invisible(NULL))
+  }
+
+  input_failure("Expecting data.frame input.")
+}
+
+block_output_ptype.plot_block <- function(x, ...) ggplot()
+```
+
+Besides, there is no need to specify the __classes__ as this is automatically retrieved from the constructed block.
+As a consequence, the new registration looks like:
+
+```r
+# NEW
+register_block(
+  constructor = new_ggplot_block,
+  name = "ggplot",
+  description = "Initialise a ggplot2 plot",
+  category = "Plot",
+  package = pkg
+)
+
+# OLD
+register_block(
+  constructor = new_ggplot_block,
+  name = "ggplot",
+  description = "Initialise a ggplot2 plot",
+  classes = c("ggplot_block", "plot_block"),
+  input = "plot",
+  output = "plot",
+  category = "Plot",
+  package = pkg
+)
+```
+
 # blockr 0.0.2.9031
 
 ## Feature

R/block-core.R

@@ -312,3 +312,89 @@ update_fields.transform_block <- function(x, session, data, ...) {
 #' @rdname update_fields
 #' @export
 update_fields.plot_block <- update_fields.transform_block
+
+#' Block input/output
+#'
+#' Used for checking whether blocks are compatible
+#'
+#' @param x Block
+#' @param data Input data.
+#' @param ... For generic consistency.
+#' @rdname block_io
+#' @export
+block_input_check <- function(x, data, ...) UseMethod("block_input_check")
+
+#' @rdname block_io
+#' @export
+block_input_check.data_block <- function(x, data, ...) {
+
+  if (missing(data) || is.null(data)) {
+    return(invisible(NULL))
+  }
+
+  input_failure("No (or empty) input expected.")
+}
+
+#' @rdname block_io
+#' @export
+block_input_check.transform_block <- function(x, data, ...) {
+
+  if (inherits(data, "data.frame")) {
+    return(invisible(NULL))
+  }
+
+  input_failure("Expecting data.frame input.")
+}
+
+#' @rdname block_io
+#' @export
+block_input_check.parser_block <- function(x, data, ...) {
+
+  if (is_string(data)) {
+    return(invisible(NULL))
+  }
+
+  input_failure("Expecting string-valued input.")
+}
+
+#' @rdname block_io
+#' @export
+block_input_check.result_block <- function(x, data, ...) {
+
+  if (length(get_workspace_stacks()) <= 1L) {
+    input_failure("Expecting at least two stacks.")
+  }
+
+  NextMethod()
+}
+
+#' @rdname block_io
+#' @param class Custom class
+#' @export
+input_failure <- function(..., class = character()) {
+  rlang::abort(paste0(...), class = c(class, "input_failure"))
+}
+
+#' @rdname block_io
+#' @export
+block_output_ptype <- function(x, ...) UseMethod("block_output_ptype")
+
+#' @rdname block_io
+#' @export
+block_output_ptype.dataset_block <- function(x, ...) data.frame()
+
+#' @rdname block_io
+#' @export
+block_output_ptype.result_block <- function(x, ...) value(x[["stack"]])
+
+#' @rdname block_io
+#' @export
+block_output_ptype.upload_block <- function(x, ...) character(1L)
+
+#' @rdname block_io
+#' @export
+block_output_ptype.filesbrowser_block <- function(x, ...) character(1L)
+
+#' @rdname block_io
+#' @export
+block_output_ptype.transform_block <- function(x, ...) data.frame()