From 6553862684d6d945f5e92ad92c3d8a66d9a3cc1f Mon Sep 17 00:00:00 2001
From: DivadNojnarg <dgranjon@ymail.com>
Date: Thu, 28 Sep 2023 18:04:09 +0200
Subject: [PATCH 01/12] start add block feature

---
 NAMESPACE              |   1 +
 R/server.R             | 100 +++++++++++++++++++++++++++++++----------
 R/stack.R              |   2 +-
 R/ui.R                 |  64 ++++++++++++++------------
 man/generate_server.Rd |   6 +--
 5 files changed, 117 insertions(+), 56 deletions(-)

diff --git a/NAMESPACE b/NAMESPACE
index 7d624080..01b4ca02 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -86,4 +86,5 @@ export(validate_field)
 export(value)
 export(values)
 export(variable_field)
+import(shiny)
 importFrom(magrittr,"%>%")
diff --git a/R/server.R b/R/server.R
index 75ad95d1..5e0a0d99 100644
--- a/R/server.R
+++ b/R/server.R
@@ -1,11 +1,12 @@
-#' UI
+#' Server
 #'
-#' Generic for UI generation
+#' Generic for server generation
 #'
-#' @param x Object for which to generate a [shiny::moduleServer()]
+#' @param x Object for which to generate a [moduleServer()]
 #' @param ... Generic consistency
 #'
 #' @export
+#' @import shiny
 generate_server <- function(x, ...) {
   UseMethod("generate_server")
 }
@@ -34,19 +35,19 @@ generate_server.data_block <- function(x, ...) {
     )
   }
 
-  shiny::moduleServer(
+  moduleServer(
     attr(x, "name"),
     function(input, output, session) {
 
-      blk <- shiny::reactiveVal(x)
+      blk <- reactiveVal(x)
 
-      shiny::observeEvent(
+      observeEvent(
         eval(obs_expr(blk())),
         eval(set_expr(blk())),
         ignoreInit = TRUE
       )
 
-      out_dat <- shiny::reactive(
+      out_dat <- reactive(
         evalute_block(blk())
       )
 
@@ -77,19 +78,19 @@ generate_server.transform_block <- function(x, in_dat, ...) {
     )
   }
 
-  shiny::moduleServer(
+  moduleServer(
     attr(x, "name"),
     function(input, output, session) {
 
-      blk <- shiny::reactiveVal(x)
+      blk <- reactiveVal(x)
 
-      shiny::observeEvent(
+      observeEvent(
         eval(obs_expr(blk())),
         eval(set_expr(blk())),
         ignoreInit = TRUE
       )
 
-      out_dat <- shiny::reactive(
+      out_dat <- reactive(
         evalute_block(blk(), data = in_dat())
       )
 
@@ -107,23 +108,76 @@ generate_server.stack <- function(x, ...) {
 
   stopifnot(...length() == 0L)
 
-  shiny::moduleServer(
+  moduleServer(
     attr(x, "name"),
     function(input, output, session) {
+      ns <- session$ns
+      vals <- reactiveValues(blocks = vector("list", length(x)))
+      init_blocks(x, vals)
+
+      # Add block
+      observeEvent(input$add, {
+        showModal(
+          modalDialog(
+            selectInput(
+              ns("block_to_add"),
+              "Which block do you want to add?",
+              choices = c("filter") # TO DO: don't hardcode this
+            ),
+            title = "Add a new block",
+            footer = modalButton("Dismiss"),
+            size = "m",
+            easyClose = FALSE,
+            fade = TRUE
+          )
+        )
+      })
+
+      observeEvent(input$block_to_add, {
+        # Update stack
+        x[[length(x) + 1]] <- do.call(
+          filter_block,
+          list(vals$blocks[[length(x)]]())
+        )
+        # Call module
+        vals$blocks[[length(x)]] <- generate_server(
+          x[[length(x)]],
+          in_dat = vals$blocks[[length(x) - 1]]
+        )
+
+        # Insert UI after last block
+        insertUI(
+          sprintf(
+            "#%s-%s-block",
+            attr(x, "name"),
+            attr(x[[length(x) - 1]], "name")
+          ),
+          where = "afterEnd",
+          ui = generate_ui(
+            x[[length(x)]],
+            id = attr(x[[length(x)]], "name")
+          )
+        )
+      })
+
+      vals
 
-      res <- vector("list", length(x))
-
-      res[[1L]] <- generate_server(x[[1L]])
-
-      for (i in seq_along(x)[-1L]) {
-        res[[i]] <- generate_server(x[[i]], in_dat = res[[i - 1L]])
-      }
-
-      res
     }
   )
 }
 
+init_blocks <- function(x, vals) {
+  observeEvent(TRUE, {
+    vals$blocks[[1L]] <- generate_server(x[[1L]])
+    for (i in seq_along(x)[-1L]) {
+      vals$blocks[[i]] <- generate_server(
+        x[[i]],
+        in_dat = vals$blocks[[i - 1L]]
+      )
+    }
+  })
+}
+
 #' @param output Shiny output
 #' @param result Block result
 #' @rdname generate_ui
@@ -135,7 +189,7 @@ server_output <- function(x, result, output) {
 #' @rdname generate_ui
 #' @export
 server_output.block <- function(x, result, output) {
-  output$output <- shiny::renderPrint(result())
+  output$output <- renderPrint(result())
   output
 }
 
@@ -150,7 +204,7 @@ server_code <- function(x, state, output) {
 #' @export
 server_code.block <- function(x, state, output) {
 
-  output$code <- shiny::renderPrint(
+  output$code <- renderPrint(
     cat(deparse(generate_code(state())), sep = "\n")
   )
 
diff --git a/R/stack.R b/R/stack.R
index 531b1a7d..97c95cda 100644
--- a/R/stack.R
+++ b/R/stack.R
@@ -42,5 +42,5 @@ serve_stack <- function(stack) {
     generate_server(stack)
   }
 
-  shiny::shinyApp(ui, server)
+  shinyApp(ui, server)
 }
diff --git a/R/ui.R b/R/ui.R
index d131cede..d8a0c0e8 100644
--- a/R/ui.R
+++ b/R/ui.R
@@ -17,8 +17,8 @@ generate_ui.block <- function(x, id, ...) {
 
   stopifnot(...length() == 0L)
 
-  ns <- shiny::NS(
-    shiny::NS(id)(attr(x, "name"))
+  ns <- NS(
+    NS(id)(attr(x, "name"))
   )
 
   fields <- Map(
@@ -29,8 +29,9 @@ generate_ui.block <- function(x, id, ...) {
   )
 
   div_card(
-    title = shiny::h4(attr(x, "name")),
-    do.call(shiny::div, unname(fields)),
+    id = ns("block"),
+    title = h4(attr(x, "name")),
+    do.call(div, unname(fields)),
     ui_code(x, ns),
     ui_output(x, ns)
   )
@@ -42,12 +43,17 @@ generate_ui.stack <- function(x, ...) {
 
   stopifnot(...length() == 0L)
 
-  do.call(
-    shiny::fluidPage,
-    c(
-      lapply(x, generate_ui, id = attr(x, "name")),
-      title = attr(x, "name")
-    )
+  ns <- NS(attr(x, "name"))
+
+  tagList(
+    do.call(
+      fluidPage,
+      c(
+        lapply(x, generate_ui, id = attr(x, "name")),
+        title = attr(x, "name")
+      )
+    ),
+    actionButton(ns("add"), icon("plus"))
   )
 }
 
@@ -61,13 +67,13 @@ ui_input <- function(x, id, name) {
 #' @rdname generate_ui
 #' @export
 ui_input.string_field <- function(x, id, name) {
-  shiny::textInput(input_ids(x, id), name, value(x))
+  textInput(input_ids(x, id), name, value(x))
 }
 
 #' @rdname generate_ui
 #' @export
 ui_input.select_field <- function(x, id, name) {
-  shiny::selectInput(
+  selectInput(
     input_ids(x, id), name, value(x, "choices"), value(x), value(x, "multiple")
   )
 }
@@ -105,7 +111,7 @@ ui_input.variable_field <- function(x, id, name) {
     materialize_variable_field(x)
   )
 
-  shiny::div(
+  div(
     id = paste0(id, "_cont"),
     ui_input(field, id, name)
   )
@@ -114,7 +120,7 @@ ui_input.variable_field <- function(x, id, name) {
 #' @rdname generate_ui
 #' @export
 ui_input.range_field <- function(x, id, name) {
-  shiny::sliderInput(
+  sliderInput(
     input_ids(x, id), name, value(x, "min"), value(x, "max"), value(x)
   )
 }
@@ -142,7 +148,7 @@ ui_input.list_field <- function(x, id, name) {
     map(ui_input, fields, input_ids(x, id), names(fields))
   )
 
-  do.call(shiny::div, args)
+  do.call(div, args)
 }
 
 #' @param session Shiny session
@@ -155,13 +161,13 @@ ui_update <- function(x, session, id, name) {
 #' @rdname generate_ui
 #' @export
 ui_update.string_field <- function(x, session, id, name) {
-  shiny::updateTextInput(session, input_ids(x, id), name, value(x))
+  updateTextInput(session, input_ids(x, id), name, value(x))
 }
 
 #' @rdname generate_ui
 #' @export
 ui_update.select_field <- function(x, session, id, name) {
-  shiny::updateSelectInput(
+  updateSelectInput(
     session, input_ids(x, id), name, value(x, "choices"), value(x)
   )
 }
@@ -173,7 +179,7 @@ ui_update.variable_field <- function(x, session, id, name) {
   ns <- session$ns
   ns_id <- ns(id)
 
-  shiny::removeUI(
+  removeUI(
     selector = paste0("#", ns_id, "_cont", " > div"),
     session = session
   )
@@ -182,7 +188,7 @@ ui_update.variable_field <- function(x, session, id, name) {
     materialize_variable_field(x)
   )
 
-  shiny::insertUI(
+  insertUI(
     selector = paste0("#", ns_id, "_cont"),
     ui = ui_input(field, ns_id, name),
     session = session
@@ -192,7 +198,7 @@ ui_update.variable_field <- function(x, session, id, name) {
 #' @rdname generate_ui
 #' @export
 ui_update.range_field <- function(x, session, id, name) {
-  shiny::updateSliderInput(
+  updateSliderInput(
     session, input_ids(x, id), name, value(x), value(x, "min"), value(x, "max")
   )
 }
@@ -210,7 +216,7 @@ ui_update.list_field <- function(x, session, id, name) {
   ns <- session$ns
   ns_id <- ns(id)
 
-  shiny::removeUI(
+  removeUI(
     selector = paste0("#", ns_id, "_cont", " > div"),
     multiple = TRUE,
     session = session
@@ -221,10 +227,10 @@ ui_update.list_field <- function(x, session, id, name) {
     validate_field
   )
 
-  shiny::insertUI(
+  insertUI(
     selector = paste0("#", ns_id, "_cont"),
     ui = do.call(
-      shiny::tagList,
+      tagList,
       map(
         ui_input, fields, input_ids(x, ns_id), paste0(name, "_", names(fields))
       )
@@ -234,18 +240,18 @@ ui_update.list_field <- function(x, session, id, name) {
 }
 
 div_card <- function(..., title = NULL, footer = NULL) {
-  shiny::div(
+  div(
     class = "panel panel-default",
     style = "margin: 10px",
     if (not_null(title)) {
-      shiny::div(title, class = "panel-heading")
+      div(title, class = "panel-heading")
     },
-    shiny::div(
+    div(
       class = "panel-body",
       ...
     ),
     if (not_null(footer)) {
-      shiny::div(footer, class = "panel-footer")
+      div(footer, class = "panel-footer")
     }
   )
 }
@@ -260,7 +266,7 @@ ui_output <- function(x, ns) {
 #' @rdname generate_ui
 #' @export
 ui_output.block <- function(x, ns) {
-  shiny::verbatimTextOutput(ns("output"))
+  verbatimTextOutput(ns("output"))
 }
 
 #' @rdname generate_ui
@@ -272,5 +278,5 @@ ui_code <- function(x, ns) {
 #' @rdname generate_ui
 #' @export
 ui_code.block <- function(x, ns) {
-  shiny::verbatimTextOutput(ns("code"))
+  verbatimTextOutput(ns("code"))
 }
diff --git a/man/generate_server.Rd b/man/generate_server.Rd
index ae2b63bb..695c1e75 100644
--- a/man/generate_server.Rd
+++ b/man/generate_server.Rd
@@ -6,7 +6,7 @@
 \alias{generate_server.data_block}
 \alias{generate_server.transform_block}
 \alias{generate_server.stack}
-\title{UI}
+\title{Server}
 \usage{
 generate_server(x, ...)
 
@@ -19,12 +19,12 @@ generate_server(x, ...)
 \method{generate_server}{stack}(x, ...)
 }
 \arguments{
-\item{x}{Object for which to generate a \code{\link[shiny:moduleServer]{shiny::moduleServer()}}}
+\item{x}{Object for which to generate a \code{\link[=moduleServer]{moduleServer()}}}
 
 \item{...}{Generic consistency}
 
 \item{in_dat}{Reactive input data}
 }
 \description{
-Generic for UI generation
+Generic for server generation
 }

From f481fc18c5ef301deba51d3c812c8363f1cb4956 Mon Sep 17 00:00:00 2001
From: DivadNojnarg <dgranjon@ymail.com>
Date: Fri, 29 Sep 2023 09:29:21 +0200
Subject: [PATCH 02/12] start support remove block

---
 R/server.R | 91 ++++++++++++++++++++++++++++++++++++++++++------------
 R/ui.R     | 11 +++++--
 2 files changed, 80 insertions(+), 22 deletions(-)

diff --git a/R/server.R b/R/server.R
index 5e0a0d99..5da83938 100644
--- a/R/server.R
+++ b/R/server.R
@@ -38,10 +38,10 @@ generate_server.data_block <- function(x, ...) {
   moduleServer(
     attr(x, "name"),
     function(input, output, session) {
-
+      ns <- session$ns
       blk <- reactiveVal(x)
 
-      observeEvent(
+      o <- observeEvent(
         eval(obs_expr(blk())),
         eval(set_expr(blk())),
         ignoreInit = TRUE
@@ -54,7 +54,15 @@ generate_server.data_block <- function(x, ...) {
       output <- server_output(x, out_dat, output)
       output <- server_code(x, blk, output)
 
-      out_dat
+      # Cleanup module inputs (UI and server side)
+      # and observer
+      observeEvent(input$remove, {
+        removeUI(sprintf("#%s", ns("block")), immediate = TRUE)
+        remove_shiny_inputs(id = attr(x, "name"), input)
+        o$destroy()
+      })
+
+      list(dat = out_dat, remove = reactive(input$remove))
     }
   )
 }
@@ -84,7 +92,7 @@ generate_server.transform_block <- function(x, in_dat, ...) {
 
       blk <- reactiveVal(x)
 
-      observeEvent(
+      o <- observeEvent(
         eval(obs_expr(blk())),
         eval(set_expr(blk())),
         ignoreInit = TRUE
@@ -97,7 +105,16 @@ generate_server.transform_block <- function(x, in_dat, ...) {
       output <- server_output(x, out_dat, output)
       output <- server_code(x, blk, output)
 
-      out_dat
+      # Cleanup module inputs (UI and server side)
+      # and observer
+      observeEvent(input$remove, {
+        message(sprintf("CLEANING UP BLOCK %s", attr(x, "name")))
+        removeUI(sprintf("#%s", ns("block")), immediate = TRUE)
+        remove_shiny_inputs(id = attr(x, "name"), input)
+        o$destroy()
+      })
+
+      list(dat = out_dat, remove = reactive(input$remove))
     }
   )
 }
@@ -119,11 +136,8 @@ generate_server.stack <- function(x, ...) {
       observeEvent(input$add, {
         showModal(
           modalDialog(
-            selectInput(
-              ns("block_to_add"),
-              "Which block do you want to add?",
-              choices = c("filter") # TO DO: don't hardcode this
-            ),
+            "TO DO: add a confirm button and a select input to select
+            which block to add ...",
             title = "Add a new block",
             footer = modalButton("Dismiss"),
             size = "m",
@@ -133,25 +147,43 @@ generate_server.stack <- function(x, ...) {
         )
       })
 
-      observeEvent(input$block_to_add, {
+      observeEvent(input$add, {
         # Update stack
+        block_to_add <- if (length(x) == 0) {
+          data_block
+        } else {
+          filter_block
+        }
+        browser()
         x[[length(x) + 1]] <- do.call(
-          filter_block,
-          list(vals$blocks[[length(x)]]())
+          block_to_add,
+          list(vals$blocks[[length(x)]]$dat())
         )
         # Call module
         vals$blocks[[length(x)]] <- generate_server(
           x[[length(x)]],
-          in_dat = vals$blocks[[length(x) - 1]]
+          in_dat = vals$blocks[[length(x) - 1]]$dat
         )
 
-        # Insert UI after last block
-        insertUI(
-          sprintf(
+        # Correct selector
+        if (length(x) == 1) {
+          # If this is the first module inserted,
+          # we target the body container.
+          # TO DO: we should actually have a proper UI for the stack
+          # to avoid targeting .container-fluid ...
+          selector <- ".container-fluid"
+        } else {
+          # Target the previous block
+          selector <- sprintf(
             "#%s-%s-block",
             attr(x, "name"),
             attr(x[[length(x) - 1]], "name")
-          ),
+          )
+        }
+
+        # Insert UI after last block
+        insertUI(
+          selector,
           where = "afterEnd",
           ui = generate_ui(
             x[[length(x)]],
@@ -160,6 +192,19 @@ generate_server.stack <- function(x, ...) {
         )
       })
 
+      # Remove block from stack (can't be done within the block)
+      to_remove <- NULL
+      observeEvent({
+        lapply(seq_along(vals$blocks), function(i) {
+          to_remove <<- i
+          tmp <- vals$blocks[[i]]
+          req(tmp[["remove"]]() > 0)
+        })
+      }, {
+        message(sprintf("REMOVING BLOCK %s", to_remove))
+        x[[to_remove]] <- NULL
+      })
+
       vals
 
     }
@@ -172,12 +217,20 @@ init_blocks <- function(x, vals) {
     for (i in seq_along(x)[-1L]) {
       vals$blocks[[i]] <- generate_server(
         x[[i]],
-        in_dat = vals$blocks[[i - 1L]]
+        in_dat = vals$blocks[[i - 1L]]$dat
       )
     }
   })
 }
 
+remove_shiny_inputs <- function(id, .input) {
+  invisible(
+    lapply(grep(id, names(.input), value = TRUE), function(i) {
+      .subset2(.input, "impl")$.values$remove(i)
+    })
+  )
+}
+
 #' @param output Shiny output
 #' @param result Block result
 #' @rdname generate_ui
diff --git a/R/ui.R b/R/ui.R
index d8a0c0e8..95174478 100644
--- a/R/ui.R
+++ b/R/ui.R
@@ -28,13 +28,18 @@ generate_ui.block <- function(x, id, ...) {
     name = names(x)
   )
 
-  div_card(
-    id = ns("block"),
-    title = h4(attr(x, "name")),
+  block_ui <- div_card(
+    title = h4(
+      attr(x, "name"),
+      actionButton(ns("remove"), icon("trash"), class = "pull-right")
+    )
+    ,
     do.call(div, unname(fields)),
     ui_code(x, ns),
     ui_output(x, ns)
   )
+  block_ui$attribs$id <- ns("block")
+  block_ui
 }
 
 #' @rdname generate_ui

From 17e81a0705b4456bb2e910e2798b9055fa80ea16 Mon Sep 17 00:00:00 2001
From: DivadNojnarg <dgranjon@ymail.com>
Date: Fri, 29 Sep 2023 09:40:17 +0200
Subject: [PATCH 03/12] make linter happy ...

---
 R/server.R | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/R/server.R b/R/server.R
index 5da83938..83ff75e9 100644
--- a/R/server.R
+++ b/R/server.R
@@ -57,6 +57,7 @@ generate_server.data_block <- function(x, ...) {
       # Cleanup module inputs (UI and server side)
       # and observer
       observeEvent(input$remove, {
+        message(sprintf("CLEANING UP BLOCK %s", attr(x, "name")))
         removeUI(sprintf("#%s", ns("block")), immediate = TRUE)
         remove_shiny_inputs(id = attr(x, "name"), input)
         o$destroy()
@@ -89,7 +90,7 @@ generate_server.transform_block <- function(x, in_dat, ...) {
   moduleServer(
     attr(x, "name"),
     function(input, output, session) {
-
+      ns <- session$ns
       blk <- reactiveVal(x)
 
       o <- observeEvent(
@@ -128,7 +129,6 @@ generate_server.stack <- function(x, ...) {
   moduleServer(
     attr(x, "name"),
     function(input, output, session) {
-      ns <- session$ns
       vals <- reactiveValues(blocks = vector("list", length(x)))
       init_blocks(x, vals)
 

From da2d1928549945e989be74a15df2fb65407f75c4 Mon Sep 17 00:00:00 2001
From: DivadNojnarg <dgranjon@ymail.com>
Date: Fri, 29 Sep 2023 09:47:38 +0200
Subject: [PATCH 04/12] fix namespace issue

---
 R/server.R | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/R/server.R b/R/server.R
index 83ff75e9..ab312c12 100644
--- a/R/server.R
+++ b/R/server.R
@@ -154,7 +154,6 @@ generate_server.stack <- function(x, ...) {
         } else {
           filter_block
         }
-        browser()
         x[[length(x) + 1]] <- do.call(
           block_to_add,
           list(vals$blocks[[length(x)]]$dat())
@@ -187,7 +186,7 @@ generate_server.stack <- function(x, ...) {
           where = "afterEnd",
           ui = generate_ui(
             x[[length(x)]],
-            id = attr(x[[length(x)]], "name")
+            id = attr(x, "name")
           )
         )
       })

From 12690461531e72bb8204e496f949d59f9a009956 Mon Sep 17 00:00:00 2001
From: DivadNojnarg <dgranjon@ymail.com>
Date: Fri, 29 Sep 2023 18:11:16 +0200
Subject: [PATCH 05/12] intermediate commit: still need to handle empty stack
 add

---
 R/server.R | 97 ++++++++++++++++++++++++++++++++++++++----------------
 R/ui.R     | 19 +++++++++++
 2 files changed, 87 insertions(+), 29 deletions(-)

diff --git a/R/server.R b/R/server.R
index ab312c12..01ec74f3 100644
--- a/R/server.R
+++ b/R/server.R
@@ -57,13 +57,20 @@ generate_server.data_block <- function(x, ...) {
       # Cleanup module inputs (UI and server side)
       # and observer
       observeEvent(input$remove, {
-        message(sprintf("CLEANING UP BLOCK %s", attr(x, "name")))
-        removeUI(sprintf("#%s", ns("block")), immediate = TRUE)
-        remove_shiny_inputs(id = attr(x, "name"), input)
-        o$destroy()
-      })
+        # Can only remove when it is the last stack block
+        if (length(session$userData$stack) == 1) {
+          message(sprintf("CLEANING UP BLOCK %s", attr(x, "name")))
+          removeUI(sprintf("#%s", ns("block")), immediate = TRUE)
+          remove_shiny_inputs(id = attr(x, "name"), input)
+          o$destroy()
+        }
+        # We have to set high priority so this event
+        # executes before the one in the stack which
+        # updates the stack. If we don't, this will
+        # never execute because the stack will be empty :)
+      }, priority = 500)
 
-      list(dat = out_dat, remove = reactive(input$remove))
+      out_dat
     }
   )
 }
@@ -110,12 +117,12 @@ generate_server.transform_block <- function(x, in_dat, ...) {
       # and observer
       observeEvent(input$remove, {
         message(sprintf("CLEANING UP BLOCK %s", attr(x, "name")))
-        removeUI(sprintf("#%s", ns("block")), immediate = TRUE)
+        removeUI(sprintf("#%s", ns("block")))
         remove_shiny_inputs(id = attr(x, "name"), input)
         o$destroy()
       })
 
-      list(dat = out_dat, remove = reactive(input$remove))
+      out_dat
     }
   )
 }
@@ -129,7 +136,7 @@ generate_server.stack <- function(x, ...) {
   moduleServer(
     attr(x, "name"),
     function(input, output, session) {
-      vals <- reactiveValues(blocks = vector("list", length(x)))
+      vals <- reactiveValues(stack = x, blocks = vector("list", length(x)))
       init_blocks(x, vals)
 
       # Add block
@@ -138,7 +145,7 @@ generate_server.stack <- function(x, ...) {
           modalDialog(
             "TO DO: add a confirm button and a select input to select
             which block to add ...",
-            title = "Add a new block",
+            title = h3(icon("check"), "Add a new block"),
             footer = modalButton("Dismiss"),
             size = "m",
             easyClose = FALSE,
@@ -149,23 +156,28 @@ generate_server.stack <- function(x, ...) {
 
       observeEvent(input$add, {
         # Update stack
-        block_to_add <- if (length(x) == 0) {
+        block_to_add <- if (length(vals$stack) == 0) {
           data_block
         } else {
           filter_block
         }
-        x[[length(x) + 1]] <- do.call(
+
+        vals$stack[[length(vals$stack) + 1]] <- do.call(
           block_to_add,
-          list(vals$blocks[[length(x)]]$dat())
+          list(vals$blocks[[length(vals$stack)]]())
         )
         # Call module
-        vals$blocks[[length(x)]] <- generate_server(
-          x[[length(x)]],
-          in_dat = vals$blocks[[length(x) - 1]]$dat
+        vals$blocks[[length(vals$stack)]] <- generate_server(
+          vals$stack[[length(vals$stack)]],
+          in_dat = if (length(vals$stack) == 1) {
+            NULL
+          } else {
+            vals$blocks[[length(vals$stack) - 1]]
+          }
         )
 
         # Correct selector
-        if (length(x) == 1) {
+        if (length(vals$stack) == 1) {
           # If this is the first module inserted,
           # we target the body container.
           # TO DO: we should actually have a proper UI for the stack
@@ -175,8 +187,8 @@ generate_server.stack <- function(x, ...) {
           # Target the previous block
           selector <- sprintf(
             "#%s-%s-block",
-            attr(x, "name"),
-            attr(x[[length(x) - 1]], "name")
+            attr(vals$stack, "name"),
+            attr(vals$stack[[length(vals$stack) - 1]], "name")
           )
         }
 
@@ -185,23 +197,46 @@ generate_server.stack <- function(x, ...) {
           selector,
           where = "afterEnd",
           ui = generate_ui(
-            x[[length(x)]],
-            id = attr(x, "name")
+            vals$stack[[length(vals$stack)]],
+            id = attr(vals$stack, "name")
           )
         )
+
+        # Necessary to communicate with downstream modules
+        session$userData$stack <- vals$stack
       })
 
       # Remove block from stack (can't be done within the block)
       to_remove <- NULL
       observeEvent({
-        lapply(seq_along(vals$blocks), function(i) {
-          to_remove <<- i
-          tmp <- vals$blocks[[i]]
-          req(tmp[["remove"]]() > 0)
-        })
+        req(input$last_changed)
+        if (grepl("remove", input$last_changed$name)) {
+          req(input$last_changed$value > 0)
+        }
       }, {
-        message(sprintf("REMOVING BLOCK %s", to_remove))
-        x[[to_remove]] <- NULL
+        # Retrieve index of block to remove
+        blocks_ids <- paste(
+          attr(x, "name"),
+          vapply(vals$stack, \(x) attr(x, "name"), FUN.VALUE = character(1)),
+          sep = "-"
+        )
+        block_id <- strsplit(input$last_changed$name, "-remove")[[1]][1]
+        to_remove <- which(blocks_ids == block_id)
+
+        # We can't remove the data block if there are downstream consumers...
+        if (to_remove == 1 && length(vals$stack) > 1) {
+          showModal(
+            modalDialog(
+              title = h3(icon("xmark"), "Error"),
+              "Can't remove a datablock whenever there are 
+              downstream data block consumers."
+            )
+          )
+        } else {
+          message(sprintf("REMOVING BLOCK %s", to_remove))
+          vals$stack[[to_remove]] <- NULL
+          session$userData$stack <- vals$stack
+        }
       })
 
       vals
@@ -210,18 +245,22 @@ generate_server.stack <- function(x, ...) {
   )
 }
 
+#' Init blocks server
+#' @keywords internal
 init_blocks <- function(x, vals) {
   observeEvent(TRUE, {
     vals$blocks[[1L]] <- generate_server(x[[1L]])
     for (i in seq_along(x)[-1L]) {
       vals$blocks[[i]] <- generate_server(
         x[[i]],
-        in_dat = vals$blocks[[i - 1L]]$dat
+        in_dat = vals$blocks[[i - 1L]]
       )
     }
   })
 }
 
+#' Cleanup module inputs
+#' @keywords internal
 remove_shiny_inputs <- function(id, .input) {
   invisible(
     lapply(grep(id, names(.input), value = TRUE), function(i) {
diff --git a/R/ui.R b/R/ui.R
index 95174478..8054e6c3 100644
--- a/R/ui.R
+++ b/R/ui.R
@@ -51,6 +51,25 @@ generate_ui.stack <- function(x, ...) {
   ns <- NS(attr(x, "name"))
 
   tagList(
+    tags$script(HTML(
+      sprintf("$(document).on(
+        'shiny:inputchanged',
+        function(event) {
+          console.log(event.name);
+          if (event.name.match('(last_changed|clientdata)') === null) {
+            Shiny.setInputValue(
+              '%s',
+              {
+                name: event.name,
+                value: event.value,
+                type: event.inputType,
+                binding: event.binding !== null ? event.binding.name : ''
+              }
+            );
+          }
+      });",
+      ns("last_changed")
+    ))),
     do.call(
       fluidPage,
       c(

From 6a40769a1c8c70c4228a45cea2fa5a67a14210eb Mon Sep 17 00:00:00 2001
From: DivadNojnarg <dgranjon@ymail.com>
Date: Fri, 29 Sep 2023 19:10:03 +0200
Subject: [PATCH 06/12] fix add block to empty stack

---
 R/server.R |  8 +++++++-
 R/ui.R     | 40 ++++++++++++++++++++++------------------
 2 files changed, 29 insertions(+), 19 deletions(-)

diff --git a/R/server.R b/R/server.R
index 01ec74f3..0115a265 100644
--- a/R/server.R
+++ b/R/server.R
@@ -164,14 +164,20 @@ generate_server.stack <- function(x, ...) {
 
         vals$stack[[length(vals$stack) + 1]] <- do.call(
           block_to_add,
-          list(vals$blocks[[length(vals$stack)]]())
+          if (length(vals$stack) == 0) {
+            list()
+          } else {
+            list(vals$blocks[[length(vals$stack)]]())
+          }
         )
         # Call module
         vals$blocks[[length(vals$stack)]] <- generate_server(
           vals$stack[[length(vals$stack)]],
           in_dat = if (length(vals$stack) == 1) {
+            # No data for first block
             NULL
           } else {
+            # Data from previous block
             vals$blocks[[length(vals$stack) - 1]]
           }
         )
diff --git a/R/ui.R b/R/ui.R
index 8054e6c3..ac33e681 100644
--- a/R/ui.R
+++ b/R/ui.R
@@ -51,25 +51,29 @@ generate_ui.stack <- function(x, ...) {
   ns <- NS(attr(x, "name"))
 
   tagList(
-    tags$script(HTML(
-      sprintf("$(document).on(
-        'shiny:inputchanged',
-        function(event) {
-          console.log(event.name);
-          if (event.name.match('(last_changed|clientdata)') === null) {
-            Shiny.setInputValue(
-              '%s',
-              {
-                name: event.name,
-                value: event.value,
-                type: event.inputType,
-                binding: event.binding !== null ? event.binding.name : ''
+    tags$script(
+      HTML(
+        sprintf(
+          "$(document).on(
+            'shiny:inputchanged',
+            function(event) {
+              console.log(event.name);
+              if (event.name.match('(last_changed|clientdata)') === null) {
+                Shiny.setInputValue(
+                  '%s',
+                  {
+                    name: event.name,
+                    value: event.value,
+                    type: event.inputType,
+                    binding: event.binding !== null ? event.binding.name : ''
+                  }
+                );
               }
-            );
-          }
-      });",
-      ns("last_changed")
-    ))),
+          });",
+          ns("last_changed")
+        )
+      )
+    ),
     do.call(
       fluidPage,
       c(

From 7fb43a6f19141d4f63ea803a07a26ec3d633b815 Mon Sep 17 00:00:00 2001
From: DivadNojnarg <dgranjon@ymail.com>
Date: Fri, 29 Sep 2023 20:03:35 +0200
Subject: [PATCH 07/12] fix some edge cases

---
 R/server.R | 35 +++++++++++++++++++++++++----------
 1 file changed, 25 insertions(+), 10 deletions(-)

diff --git a/R/server.R b/R/server.R
index 0115a265..8d2e9acb 100644
--- a/R/server.R
+++ b/R/server.R
@@ -57,12 +57,16 @@ generate_server.data_block <- function(x, ...) {
       # Cleanup module inputs (UI and server side)
       # and observer
       observeEvent(input$remove, {
+        # Trick to be able to tell the stack to wait
+        # for this event to run.
+        session$userData$is_cleaned(FALSE)
         # Can only remove when it is the last stack block
         if (length(session$userData$stack) == 1) {
           message(sprintf("CLEANING UP BLOCK %s", attr(x, "name")))
           removeUI(sprintf("#%s", ns("block")), immediate = TRUE)
           remove_shiny_inputs(id = attr(x, "name"), input)
           o$destroy()
+          session$userData$is_cleaned(TRUE)
         }
         # We have to set high priority so this event
         # executes before the one in the stack which
@@ -120,6 +124,7 @@ generate_server.transform_block <- function(x, in_dat, ...) {
         removeUI(sprintf("#%s", ns("block")))
         remove_shiny_inputs(id = attr(x, "name"), input)
         o$destroy()
+        session$userData$is_cleaned(TRUE)
       })
 
       out_dat
@@ -137,7 +142,7 @@ generate_server.stack <- function(x, ...) {
     attr(x, "name"),
     function(input, output, session) {
       vals <- reactiveValues(stack = x, blocks = vector("list", length(x)))
-      init_blocks(x, vals)
+      init_blocks(x, vals, session)
 
       # Add block
       observeEvent(input$add, {
@@ -213,13 +218,12 @@ generate_server.stack <- function(x, ...) {
       })
 
       # Remove block from stack (can't be done within the block)
-      to_remove <- NULL
-      observeEvent({
+      to_remove <- reactive({
         req(input$last_changed)
         if (grepl("remove", input$last_changed$name)) {
           req(input$last_changed$value > 0)
         }
-      }, {
+
         # Retrieve index of block to remove
         blocks_ids <- paste(
           attr(x, "name"),
@@ -227,10 +231,16 @@ generate_server.stack <- function(x, ...) {
           sep = "-"
         )
         block_id <- strsplit(input$last_changed$name, "-remove")[[1]][1]
-        to_remove <- which(blocks_ids == block_id)
+        tmp <- which(blocks_ids == block_id)
+        req(length(tmp) > 0)
+        tmp
+      })
 
+      session$userData$is_cleaned <- reactiveVal(FALSE)
+
+      remove_block <- observeEvent(c(to_remove(), session$userData$is_cleaned()), {
         # We can't remove the data block if there are downstream consumers...
-        if (to_remove == 1 && length(vals$stack) > 1) {
+        if (to_remove() == 1 && length(vals$stack) > 1) {
           showModal(
             modalDialog(
               title = h3(icon("xmark"), "Error"),
@@ -239,9 +249,13 @@ generate_server.stack <- function(x, ...) {
             )
           )
         } else {
-          message(sprintf("REMOVING BLOCK %s", to_remove))
-          vals$stack[[to_remove]] <- NULL
-          session$userData$stack <- vals$stack
+          message(sprintf("REMOVING BLOCK %s", to_remove()))
+          if (session$userData$is_cleaned()) {
+            vals$stack[[to_remove()]] <- NULL
+            session$userData$stack <- vals$stack
+            session$userData$is_cleaned(FALSE)
+          }
+          
         }
       })
 
@@ -253,8 +267,9 @@ generate_server.stack <- function(x, ...) {
 
 #' Init blocks server
 #' @keywords internal
-init_blocks <- function(x, vals) {
+init_blocks <- function(x, vals, session) {
   observeEvent(TRUE, {
+    session$userData$stack <- vals$stack
     vals$blocks[[1L]] <- generate_server(x[[1L]])
     for (i in seq_along(x)[-1L]) {
       vals$blocks[[i]] <- generate_server(

From e91b4dbb9236a91d8e33d3da4fd7d261f156c5f1 Mon Sep 17 00:00:00 2001
From: DivadNojnarg <dgranjon@ymail.com>
Date: Fri, 29 Sep 2023 20:15:25 +0200
Subject: [PATCH 08/12] lint

---
 R/server.R | 7 +++++--
 1 file changed, 5 insertions(+), 2 deletions(-)

diff --git a/R/server.R b/R/server.R
index 8d2e9acb..30dfaf98 100644
--- a/R/server.R
+++ b/R/server.R
@@ -238,7 +238,11 @@ generate_server.stack <- function(x, ...) {
 
       session$userData$is_cleaned <- reactiveVal(FALSE)
 
-      remove_block <- observeEvent(c(to_remove(), session$userData$is_cleaned()), {
+      observeEvent(
+        c(
+          to_remove(),
+          session$userData$is_cleaned()
+        ), {
         # We can't remove the data block if there are downstream consumers...
         if (to_remove() == 1 && length(vals$stack) > 1) {
           showModal(
@@ -255,7 +259,6 @@ generate_server.stack <- function(x, ...) {
             session$userData$stack <- vals$stack
             session$userData$is_cleaned(FALSE)
           }
-          
         }
       })
 

From 479bcea5930c1595be0e76860d0fa32189195b88 Mon Sep 17 00:00:00 2001
From: DivadNojnarg <dgranjon@ymail.com>
Date: Fri, 29 Sep 2023 23:23:41 +0200
Subject: [PATCH 09/12] lint + debug message

---
 R/server.R | 7 ++++---
 1 file changed, 4 insertions(+), 3 deletions(-)

diff --git a/R/server.R b/R/server.R
index 30dfaf98..8fe1590d 100644
--- a/R/server.R
+++ b/R/server.R
@@ -238,11 +238,12 @@ generate_server.stack <- function(x, ...) {
 
       session$userData$is_cleaned <- reactiveVal(FALSE)
 
-      observeEvent(
+      observeEvent({
         c(
           to_remove(),
           session$userData$is_cleaned()
-        ), {
+        )
+      }, {
         # We can't remove the data block if there are downstream consumers...
         if (to_remove() == 1 && length(vals$stack) > 1) {
           showModal(
@@ -253,8 +254,8 @@ generate_server.stack <- function(x, ...) {
             )
           )
         } else {
-          message(sprintf("REMOVING BLOCK %s", to_remove()))
           if (session$userData$is_cleaned()) {
+            message(sprintf("REMOVING BLOCK %s", to_remove()))
             vals$stack[[to_remove()]] <- NULL
             session$userData$stack <- vals$stack
             session$userData$is_cleaned(FALSE)

From 32edb769bf36430ddd3c64088b2231dc1081061c Mon Sep 17 00:00:00 2001
From: DivadNojnarg <dgranjon@ymail.com>
Date: Sun, 1 Oct 2023 15:38:42 +0200
Subject: [PATCH 10/12] start adding server tests

---
 man/init_blocks.Rd         | 12 +++++++++
 man/remove_shiny_inputs.Rd | 12 +++++++++
 tests/testthat/test-app.R  | 55 ++++++++++++++++++++++++++++++++++++++
 3 files changed, 79 insertions(+)
 create mode 100644 man/init_blocks.Rd
 create mode 100644 man/remove_shiny_inputs.Rd
 create mode 100644 tests/testthat/test-app.R

diff --git a/man/init_blocks.Rd b/man/init_blocks.Rd
new file mode 100644
index 00000000..2dbb20fa
--- /dev/null
+++ b/man/init_blocks.Rd
@@ -0,0 +1,12 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/server.R
+\name{init_blocks}
+\alias{init_blocks}
+\title{Init blocks server}
+\usage{
+init_blocks(x, vals, session)
+}
+\description{
+Init blocks server
+}
+\keyword{internal}
diff --git a/man/remove_shiny_inputs.Rd b/man/remove_shiny_inputs.Rd
new file mode 100644
index 00000000..7fcd6f74
--- /dev/null
+++ b/man/remove_shiny_inputs.Rd
@@ -0,0 +1,12 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/server.R
+\name{remove_shiny_inputs}
+\alias{remove_shiny_inputs}
+\title{Cleanup module inputs}
+\usage{
+remove_shiny_inputs(id, .input)
+}
+\description{
+Cleanup module inputs
+}
+\keyword{internal}
diff --git a/tests/testthat/test-app.R b/tests/testthat/test-app.R
new file mode 100644
index 00000000..9cd975f2
--- /dev/null
+++ b/tests/testthat/test-app.R
@@ -0,0 +1,55 @@
+stack <- new_stack(
+  data_block,
+  filter_block
+)
+
+# Test stack module
+# A bit hacky but generate_server.stack does not valspect
+# the pvalscription for shiny module testing (the function
+# must have id as first param.
+my_stack <- function(id, x) {
+
+}
+body(my_stack) <- body(generate_server.stack)[-2]
+testServer(my_stack, args = list(x = stack), {
+  # # # # # # #
+  #           #
+  # INIT TEST #
+  #           #
+  # # # # # # #
+  
+  # Let's check we have correct init state ...
+  expect_length(vals$stack, 2)
+  expect_length(vals$blocks, 2)
+
+  # Test data block
+  data_block <- vals$stack[[1]]
+  data_block_field <- data_block$dataset
+  expect_true(inherits(data_block, "data_block"))
+  expect_equal(data_block_field$multiple, FALSE)
+  expect_equal(data_block_field$value, "iris")
+
+  # test filter block
+  filter_block <- vals$stack[[2]]
+  filter_block_col_field <- filter_block$columns
+  filter_block_val_field <- filter_block$values
+  expect_true(inherits(filter_block, "filter_block"))
+  expect_equal(filter_block_col_field$value, colnames(iris)[[1]])
+  expect_equal(attr(filter_block_col_field$choices, "result"), colnames(iris))
+  expect_equal(filter_block_col_field$multiple, TRUE)
+
+  # # # # # # # # # #
+  #                 #
+  # REACTIVITY TEST #
+  #                 #
+  # # # # # # # # # #
+
+  # Let's make some change
+  session$setInputs(add = 1)
+  expect_length(vals$stack, 3)
+  expect_length(vals$blocks, 3)
+  expect_true(inherits(filter_block, "filter_block"))
+  # Test user data necessary to communicate with submodules
+  expect_equal(ls(session$userData), c("is_cleaned", "stack"))
+  print(ls(session$userData))
+})

From 3adab7bb2459137e6fb3508950ffaca4bf7e327a Mon Sep 17 00:00:00 2001
From: DivadNojnarg <dgranjon@ymail.com>
Date: Sun, 1 Oct 2023 16:15:20 +0200
Subject: [PATCH 11/12] finish test stack + lint

---
 tests/testthat/test-app.R | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/tests/testthat/test-app.R b/tests/testthat/test-app.R
index 9cd975f2..b35424c4 100644
--- a/tests/testthat/test-app.R
+++ b/tests/testthat/test-app.R
@@ -17,7 +17,7 @@ testServer(my_stack, args = list(x = stack), {
   # INIT TEST #
   #           #
   # # # # # # #
-  
+
   # Let's check we have correct init state ...
   expect_length(vals$stack, 2)
   expect_length(vals$blocks, 2)
@@ -51,5 +51,6 @@ testServer(my_stack, args = list(x = stack), {
   expect_true(inherits(filter_block, "filter_block"))
   # Test user data necessary to communicate with submodules
   expect_equal(ls(session$userData), c("is_cleaned", "stack"))
-  print(ls(session$userData))
+  expect_equal(length(session$userData$stack), length(vals$stack))
+  expect_false(session$userData$is_cleaned())
 })

From 5279bf8c0ddad4086df44bca5057aec6411ae515 Mon Sep 17 00:00:00 2001
From: DivadNojnarg <dgranjon@ymail.com>
Date: Sun, 1 Oct 2023 16:47:01 +0200
Subject: [PATCH 12/12] test data block

---
 tests/testthat/test-app.R | 18 ++++++++++++++++++
 1 file changed, 18 insertions(+)

diff --git a/tests/testthat/test-app.R b/tests/testthat/test-app.R
index b35424c4..45f1c650 100644
--- a/tests/testthat/test-app.R
+++ b/tests/testthat/test-app.R
@@ -54,3 +54,21 @@ testServer(my_stack, args = list(x = stack), {
   expect_equal(length(session$userData$stack), length(vals$stack))
   expect_false(session$userData$is_cleaned())
 })
+
+# Test data block module
+# This is a bit limited since we don't know the
+# stack state. shinytest2 would be more accurate here ...
+my_data_block <- function(id, x) {
+
+}
+body(my_data_block) <- body(generate_server.data_block)
+testServer(my_data_block, args = list(x = data_block()), {
+  expect_equal(colnames(out_dat()), colnames(iris))
+  expect_equal(nrow(out_dat()), nrow(iris))
+  session$userData$is_cleaned <- reactiveVal(NULL)
+  session$userData$stack <- 1
+  expect_false(o$.destroyed)
+  expect_message(session$setInputs(remove = 1))
+  expect_true(session$userData$is_cleaned())
+  expect_true(o$.destroyed)
+})