Refactor server logic to enable result triggers

[nbenn]

WIP

[DivadNojnarg]

TODO: handle stack removal (result also needs to be updated)

[nbenn]

@DivadNojnarg I think this mostly works now. Your TODO from above is also covered. Let me know if you find some scenarios that still cause issues.

[DivadNojnarg]

Thanks for fixing the last piece. There is a tiny issue introduced by my change of the evaluate block part. This works well for basic blocks but not when we use submit: the block needs to be updated to show the correct field choices and only then we can run the result computation. My code does all at once so the UI isn't updated which leads to empty fields. I can propose a commit to fix that.

[DivadNojnarg]

@nbenn could you try this instead. I added another observer below to account for the submit case:

# What can make a block change ...
      update_blk_trigger <- reactive({
        if (inherits(x, "data_block")) {
          r_values()
        } else {
          c(r_values(), in_dat(), is_prev_valid())
        }
      })
      # This will also trigger when the previous block
      # valid status changes.
      obs$update_blk <- observeEvent(
        update_blk_trigger(),
        {
          # 1. update blk,
          b <- update_blk(
            b = blk(),
            value = r_values(),
            is_srv = is_srv,
            input = input,
            data = in_dat()
          )
          blk(b)
          log_debug("Updating block ", class(x)[[1]])

          # 2. Update UI
          update_ui(b = blk(), is_srv = is_srv, session = session, l_init = l_init)
          log_debug("Updating UI of block ", class(x)[[1]])

          # Validating
          is_valid$block <- validate_block(blk())
          is_valid$message <- attr(is_valid$block, "msg")
          is_valid$fields <- attr(is_valid$block, "fields")
          log_debug("Validating block ", class(x)[[1]])
        }
      )

      # We need to decouple blk update from evaluation since
      # for submit block this can't work within a single observer
      eval_blk_trigger <- reactive({
        if (is_valid$block) {
          if (attr(x, "submit") > -1) {
            input$submit
          } else {
            if (inherits(x, "result_block")) {
              c(r_values(), is_valid$block)
            } else {
              c(blk(), is_valid$block)
            }
          }
        }
      })

      obs$eval_res <- observeEvent(eval_blk_trigger(), {
        log_debug("Evaluating block ", class(x)[[1]])
        if (inherits(x, "data_block")) {
          out_dat(evaluate_block(blk()))
        } else {
          out_dat(evaluate_block(blk(), data = in_dat()))
        }
      }, ignoreNULL = !attr(x, "submit") > 0)

[nbenn]

@DivadNojnarg thinking a bit about

if (inherits(x, "result_block")) {
  c(r_values(), is_valid$block)
} else {
  c(blk(), is_valid$block)
}

1. The condition inherits(x, "result_block") is not what we want; better would be something like any(vapply(x, inherits, logical(1L), "result_field")), no? (Or using my own utility here: lgl_ply(x, inherits, "result_field")
2. Shouldn't the eval trigger also listen to in_dat() in case the data changed, but the block did not?
3. And what about is_prev_valid()?

Maybe only something like

eval_blk_trigger <- reactive({
  if (is_valid$block) {
    if (attr(x, "submit") > -1) {
      input$submit
    } else {
      update_blk_trigger()
    }
  }
})

What do you think?

[DivadNojnarg]

CICD fixed @nbenn