Merge pull request #8 from blockr-org/5-registry-onload

Third party registry setup

R/code.R

@@ -77,7 +77,7 @@ new_code_plot_block <- function(data, ...) {
         eval()
     }),
     ...,
-    class = c("code_transform_block", "plot_block", "submit_block")
+    class = c("code_plot_block", "plot_block", "submit_block")
   )
 }
 

R/demo-bms-blocks.R

@@ -123,7 +123,7 @@ new_plot_block <- function(
         )
     }),
     ...,
-    class = c("plot_block")
+    class = c("plot_block", "submit_block")
   )
 }
 
@@ -281,7 +281,7 @@ new_ggiraph_block <- function(
       )
     }),
     ...,
-    class = c("ggiraph_block", "plot_block")
+    class = c("ggiraph_block", "plot_block", "submit_block")
   )
 }
 
@@ -354,31 +354,41 @@ asfactor_block <- function(data, ...) {
   initialize_block(new_asfactor_block(data, ...), data)
 }
 
+#' @rdname demo_block
+#' @export
+lab_data_block <- function(...) {
+  initialize_block(new_data_block(
+    ...,
+    dat = as.environment("package:blockr.data"),
+    selected = "lab"
+  ))
+}
+
 #' @rdname demo_block
 #' @export
 demo_data_block <- function(...) {
-  initialize_block(
-    new_data_block(
-      ...,
-      dat = as.environment("package:blockr.data"),
-      selected = "lab"
-    )
-  )
+  initialize_block(new_data_block(
+    ...,
+    dat = as.environment("package:blockr.data"),
+    selected = "demo"
+  ))
 }
 
 #' @rdname demo_block
 #' @export
 demo_join_block <- function(data, ...) {
-  initialize_block(
+  blk <- initialize_block(
     new_join_block(
       data,
-      y = "demo",
       type = "inner",
-      by_col = c("STUDYID", "USUBJID"),
+      by = c("STUDYID", "USUBJID"),
       ...
     ),
     data
   )
+  class(blk) <- class(blk)[-3]
+  blk$submit <- NULL
+  blk
 }
 
 #' @rdname demo_block
@@ -404,7 +414,7 @@ demo_group_by_block <- function(data, ...) {
 #' @rdname demo_block
 #' @export
 demo_filter_block_1 <- function(data, ...) {
-  initialize_block(
+  blk <- initialize_block(
     new_filter_block(
       data,
       columns = "LBTEST",
@@ -413,12 +423,15 @@ demo_filter_block_1 <- function(data, ...) {
     ),
     data
   )
+  class(blk) <- class(blk)[-3]
+  blk$submit <- NULL
+  blk
 }
 
 #' @rdname demo_block
 #' @export
 demo_filter_block_2 <- function(data, ...) {
-  initialize_block(
+  blk <- initialize_block(
     new_filter_block(
       data,
       columns = "VISIT",
@@ -428,17 +441,23 @@ demo_filter_block_2 <- function(data, ...) {
     ),
     data
   )
+  class(blk) <- class(blk)[-3]
+  blk$submit <- NULL
+  blk
 }
 
 #' @rdname demo_block
 #' @export
 demo_summarize_block <- function(data, ...) {
-  initialize_block(
+  blk <- initialize_block(
     new_summarize_block(
       data,
       default_columns = c("LBSTRESN", "LBSTRESN"),
       ...
     ),
     data
   )
+  class(blk) <- class(blk)[-3]
+  blk$submit <- NULL
+  blk
 }

R/utils.R

@@ -32,3 +32,122 @@ ui_fields_one_column <- function(x, ns, inputs_hidden) {
     div(cards, class = "mt-3")
   )
 }
+
+register_blockr_extra_blocks <- function(pkg) {
+
+  if (missing(pkg)) {
+    pkg <- pkg_name()
+  }
+
+  register_blocks(
+    constructor = c(
+      plot_block,
+      ggiraph_block,
+      asfactor_block,
+      lab_data_block,
+      demo_data_block,
+      demo_join_block,
+      demo_arrange_block,
+      demo_group_by_block,
+      demo_filter_block_1,
+      demo_filter_block_2,
+      demo_summarize_block,
+      admiral_dpc_block,
+      filter_expr_block,
+      summarize_expr_block,
+      code_transform_block,
+      code_plot_block
+    ),
+    name = c(
+      "plot block",
+      "ggiraph block",
+      "asfactor block",
+      "lab data_block",
+      "demo data block",
+      "demo join block",
+      "demo arrange block",
+      "demo group by block",
+      "demo filter block 1",
+      "demo filter block 2",
+      "demo summarize block",
+      "admiral dpc block",
+      "filter expr block",
+      "summarize expr block",
+      "code transform block",
+      "code plot block"
+    ),
+    description = c(
+      "Monolithic ggplot block",
+      "Monolithic ggiraph block",
+      "As factor mutate block",
+      "blockr.data preselected to lab data",
+      "blockr.data preselected to demo data",
+      "Predefined join block for BMS demo",
+      "Predefined arrange block for BMS demo",
+      "Predefined group by block for BMS demo",
+      "Predefined filter block for BMS demo 1",
+      "Predefined filter block for BMS demo 2",
+      "Predefined summarize block for BMS demo",
+      "Admiral block",
+      "Filter expr block",
+      "Summarize expr block",
+      "Code transform block",
+      "Code plot block"
+    ),
+    classes = list(
+      c("plot_block", "submit_block"),
+      c("ggiraph_block", "plot_block", "submit_block"),
+      c("asfactor_block", "transform_block"),
+      c("lab_dataset_block", "data_block"),
+      c("demo_dataset_block", "data_block"),
+      c("demo_join_block", "transform_block", "submit_block"),
+      c("demo_arrange_block", "transform_block"),
+      c("demo_group_by_block", "transform_block"),
+      c("demo_filter_block_1", "transform_block", "submit_block"),
+      c("demo_filter_block_2", "transform_block", "submit_block"),
+      c("demo_summarize_block", "transform_block", "submit_block"),
+      c("admiral_dpc_block", "transform_block"),
+      c("filter_expr_block", "transform_block"),
+      c("summarize_expr_block", "transform_block"),
+      c("code_transform_block", "transform_block", "submit_block"),
+      c("code_plot_block", "plot_block", "submit_block")
+    ),
+    input = c(
+      "data.frame",
+      "data.frame",
+      "data.frame",
+      NA_character_,
+      NA_character_,
+      "data.frame",
+      "data.frame",
+      "data.frame",
+      "data.frame",
+      "data.frame",
+      "data.frame",
+      "data.frame",
+      "data.frame",
+      "data.frame",
+      "data.frame",
+      "data.frame"
+    ),
+    output = c(
+      "list",
+      "list",
+      "data.frame",
+      "data.frame",
+      "data.frame",
+      "data.frame",
+      "data.frame",
+      "data.frame",
+      "data.frame",
+      "data.frame",
+      "data.frame",
+      "data.frame",
+      "data.frame",
+      "data.frame",
+      "data.frame",
+      "data.frame"
+    ),
+    package = pkg
+  )
+}

R/zzz.R

@@ -0,0 +1,6 @@
+.onLoad <- function(libname, pkgname) { # nocov start
+
+  register_blockr_extra_blocks(pkgname)
+
+  invisible(NULL)
+} # nocov end

inst/examples/bms-demo-cdisc/app.R

@@ -6,16 +6,18 @@ library(ggiraph)
 
 # Note: sometimes memories issue due to the join block
 # can be solved by restarting R between each run.
-
-stack <- new_stack(
-  demo_data_block,
-  demo_join_block,
-  demo_filter_block_1,
-  demo_filter_block_2,
-  demo_arrange_block,
-  asfactor_block,
-  demo_group_by_block,
-  demo_summarize_block,
-  ggiraph_block
+serve_workspace(
+  stack1 = new_stack(lab_data_block, head_block),
+  stack2 = new_stack(demo_data_block, demo_join_block),
+  stack3 = new_stack(
+    result_block,
+    demo_filter_block_1,
+    demo_filter_block_2#,
+    #demo_arrange_block,
+    #asfactor_block#,
+    #demo_group_by_block,
+    #demo_summarize_block,
+    #ggiraph_block
+  ),
+  title = "My workspace"
 )
-serve_stack(stack)