[Bug]: decoration error state changes with first good run

[averissimo]

What happened?

In 2 different ways after returning to an error state after being in a good one

1. Error messages in decorators are inconsistent
   • Shown warning for 2^nd, 3^rd, ... saying that "previous decorator failed" (in initial state no warning were shown)
2. Code and plot are not updated to error state
   • Last known good state is shown

(see below on how to reproduce it):

How to reproduce either:

1. After selecting both x and y
2. Force an error state by removing x and y
3. Observe:
   1. Error messages are different from initial state
   2. Plot is still sown

Example App

options(
  teal.log_level = "ERROR",
  teal.show_js_log = TRUE,
  # teal.bs_theme = bslib::bs_theme(version = 5),
  shiny.bookmarkStore = "server"
)

pkgload::load_all("../teal")

tm_decorated_plot <- function(label = "module", transformators = list(), decorators = list(), datanames = "all") {
  checkmate::assert_list(decorators, "teal_transform_module")
  module(
    label = label,
    ui = function(id, decorators) {
      ns <- NS(id)
      div(
        style = "margin-left: 0.5em; margin-right: 0.5em;",
        tags$em("(Encoding panel)", style = "margin-bottom: 0.5em; color: gray;"),
        div(
          style = "display: flex; gap: .2em;",
          selectInput(ns("dataname"), label = "Select dataname", choices = NULL, multiple = TRUE),
          selectInput(ns("x"), label = "Select x", choices = NULL, multiple = TRUE),
          selectInput(ns("y"), label = "Select y", choices = NULL, multiple = TRUE),
        ),
        ui_transform_teal_data(ns("decorate"), transformators = decorators),
        # ui_module_validate(ns("validation")),
        tags$h4("Plot data description"),
        verbatimTextOutput(ns("description")),
        tags$h4("Main plot"),
        plotOutput(ns("plot")),
        tags$h4("Code"),
        verbatimTextOutput(ns("text"))
      )
    },
    server = function(id, data, decorators) {
      moduleServer(id, function(input, output, session) {
        observeEvent(data(), {
          dataname <- if (length(input$dataname)) input$dataname else names(data())[1]
          updateSelectInput(inputId = "dataname", choices = names(data()), selected = dataname)
        })
        
        observeEvent(input$dataname, {
          req(input$dataname)
          updateSelectInput(inputId = "x", choices = colnames(data()[[input$dataname]]))
          updateSelectInput(inputId = "y", choices = colnames(data()[[input$dataname]]))
        })
        
        dataname <- reactive(req(input$dataname))
        x <- reactive({
          req(input$x, input$x %in% colnames(data()[[dataname()]]))
          input$x
        })
        
        y <- reactive({
          req(input$y, input$y %in% colnames(data()[[dataname()]]))
          input$y
        })
        plot_data <- reactive({
          # todo: make sure it triggers once on init
          #       and once on change of its input and once on change in previous stages
          req(dataname(), x(), y())
          within(data(),
                 {
                   plot <- ggplot2::ggplot(dataname, ggplot2::aes(x = x, y = y)) +
                     ggplot2::geom_point()
                 },
                 dataname = as.name(dataname()),
                 x = as.name(x()),
                 y = as.name(y())
          )
        })
        
        extra_validation <- reactive(
          validate(
            need(
              try(req(dataname(), x(), y()), silent = TRUE),
              message = "(sample in-module usage) Please select dataname, x and y"
            )
          )
        )
        # srv_module_validate_validation("validation", extra_validation)
        
        plot_data_decorated_no_print <- srv_transform_teal_data(
          "decorate",
          data = plot_data,
          transformators = decorators
        )
        plot_data_decorated <- reactive({
          within(req(plot_data_decorated_no_print()), expr = plot)
        })
        
        plot_r <- reactive({
          plot_data_decorated()[["plot"]]
        })
        
        output$description <- renderPrint(print(req(plot_data_decorated())))
        output$plot <- renderPlot(plot_r())
        output$text <- renderText({
          teal.code::get_code(req(plot_data_decorated()))
        })
      })
    },
    ui_args = list(decorators = decorators),
    server_args = list(decorators = decorators),
    datanames = datanames,
    transformators = transformators
  )
}

make_data <- function(datanames = c("ADSL", "ADTTE")) {
  data_obj <- teal.data::teal_data()
  if ("ADSL" %in% datanames) {
    data_obj <- within(data_obj, ADSL <- teal.data::rADSL)
  }
  if ("ADTTE" %in% datanames) {
    data_obj <- within(data_obj, ADTTE <- teal.data::rADTTE)
  }
  join_keys(data_obj) <- default_cdisc_join_keys[datanames]
  data_obj
}


decor <- teal_transform_module(
  label = "X-axis decorator",
  ui = function(id) {
    ns <- NS(id)
    tags$em("A decorator")
  },
  server = function(id, data) {
    moduleServer(id, function(input, output, session) {
      logger::log_trace("example_module_transform2 initializing.")
      reactive(data() |> within(plot <- plot + ggplot2::ggtitle("Decorated Title")))
    })
  }
)

teal::init(
  data = make_data(),
  modules = list(
    tm_decorated_plot(
      "mod-2",
      # transformators = list(empty_ui_trans, trans, trans),
      decorators = list(decor, decor),
      datanames = c("ADSL", "ADTTE")
    )
  ),
  filter = teal_slices(
    teal_slice("ADSL", "SEX"),
    teal_slice("ADSL", "AGE", selected = c(18L, 65L)),
    teal_slice("ADTTE", "PARAMCD", selected = "CRSD"),
    include_varnames = list(
      ADSL = c("SEX", "AGE")
    )
  )
) |> runApp()

sessionInfo()

Relevant log output

Code of Conduct

• [x] I agree to follow this project's Code of Conduct.

Contribution Guidelines

• [x] I agree to follow this project's Contribution Guidelines.

Security Policy

• [x] I agree to follow this project's Security Policy.

[averissimo]

This is due to the srv_transform_teal_data being designed for "transformators" that assume top-level data is good.

From my perspective, we want to keep UI consistency, so that the same state presents the same-ish UI.

Proposal (live on 1322_validation@main branch -- commit a3b3afd and the previous ones)

Disable transformations if top-level data() reactive is not a teal_data object

In the example app, it's not until "encoding" produces a valid teal_data object

• This should never be the case for "transformators" as the top-level data() is defined in init() or in teal_data_module
• Showing an info box explaining why it is disabled (currently done in pure CSS)

Sample app for `1322_validation@main`

options(
  teal.log_level = "ERROR",
  teal.show_js_log = TRUE,
  # teal.bs_theme = bslib::bs_theme(version = 5),
  shiny.bookmarkStore = "server"
)

devtools::load_all("../teal")
pkgload::load_all("../teal.code")

tm_decorated_plot <- function(label = "module", transformators = list(), decorators = list(), datanames = "all") {
  checkmate::assert_list(decorators, "teal_transform_module")
  module(
    label = label,
    ui = function(id, decorators) {
      ns <- NS(id)
      div(
        style = "margin-left: 0.5em; margin-right: 0.5em;",
        tags$em("(Encoding panel)", style = "margin-bottom: 0.5em; color: gray;"),
        div(
          style = "display: flex; gap: .2em;",
          selectInput(ns("dataname"), label = "Select dataname", choices = NULL, multiple = TRUE),
          selectInput(ns("x"), label = "Select x", choices = NULL, multiple = TRUE),
          selectInput(ns("y"), label = "Select y", choices = NULL, multiple = TRUE),
        ),
        ui_transform_teal_data(ns("decorate"), transformators = decorators),
        # ui_module_validate(ns("validation")),
        tags$h4("Plot data description"),
        verbatimTextOutput(ns("description")),
        tags$h4("Main plot"),
        plotOutput(ns("plot")),
        tags$h4("Code"),
        verbatimTextOutput(ns("text"))
      )
    },
    server = function(id, data, decorators) {
      moduleServer(id, function(input, output, session) {
        observeEvent(data(), {
          dataname <- if (length(input$dataname)) input$dataname else names(data())[1]
          updateSelectInput(inputId = "dataname", choices = names(data()), selected = dataname)
        })

        observeEvent(input$dataname, {
          req(input$dataname)
          updateSelectInput(inputId = "x", choices = colnames(data()[[input$dataname]]))
          updateSelectInput(inputId = "y", choices = colnames(data()[[input$dataname]]))
        })

        dataname <- reactive(req(input$dataname))
        x <- reactive({
          req(input$x, input$x %in% colnames(data()[[dataname()]]))
          input$x
        })

        y <- reactive({
          req(input$y, input$y %in% colnames(data()[[dataname()]]))
          input$y
        })
        plot_data <- reactive({
          # todo: make sure it triggers once on init
          #       and once on change of its input and once on change in previous stages
          req(dataname(), x(), y())
          within(data(),
                 {
                   plot <- ggplot2::ggplot(dataname, ggplot2::aes(x = x, y = y)) +
                     ggplot2::geom_point()
                 },
                 dataname = as.name(dataname()),
                 x = as.name(x()),
                 y = as.name(y())
          )
        })

        extra_validation <- reactive(
          validate(
            need(
              try(req(dataname(), x(), y()), silent = TRUE),
              message = "(sample in-module usage) Please select dataname, x and y"
            )
          )
        )
        # srv_module_validate_validation("validation", extra_validation)

        plot_data_decorated_no_print <- srv_transform_teal_data(
          "decorate",
          data = plot_data,
          transformators = decorators
        )
        plot_data_decorated <- reactive({
          within(req(plot_data_decorated_no_print()), expr = plot)
        })

        plot_r <- reactive({
          plot_data_decorated()[["plot"]]
        })

        output$description <- renderPrint(print(req(plot_data_decorated())))
        output$plot <- renderPlot(plot_r())
        output$text <- renderText({
          teal.code::get_code(req(plot_data_decorated()))
        })
      })
    },
    ui_args = list(decorators = decorators),
    server_args = list(decorators = decorators),
    datanames = datanames,
    transformators = transformators
  )
}

make_data <- function(datanames = c("ADSL", "ADTTE")) {
  data_obj <- teal.data::teal_data()
  if ("ADSL" %in% datanames) {
    data_obj <- within(data_obj, ADSL <- teal.data::rADSL)
  }
  if ("ADTTE" %in% datanames) {
    data_obj <- within(data_obj, ADTTE <- teal.data::rADTTE)
  }
  join_keys(data_obj) <- default_cdisc_join_keys[datanames]
  data_obj
}

data <- teal_data_module(
  once = FALSE,
  ui = function(id) {
    ns <- NS(id)
    tagList(
      selectizeInput(
        ns("errortype"),
        label = "Error Type",
        choices = c(
          "ok", "insufficient datasets", "no data",
          "qenv.error", "error in reactive", "validate error", "silent.shiny.error", "not a reactive"
        )
      )
    )
  },
  server = function(id, ...) {
    moduleServer(id, function(input, output, session) {
      logger::log_trace("example_module_transform2 initializing.")

      reactive({
        switch(req(input$errortype),
               ok = make_data(),
               `insufficient datasets` = make_data(datanames = "ADSL"),
               `no data` = teal_data(),
               qenv.error = within(teal_data(), stop("this is qenv.error in teal_data_module (from inside within())")),
               `error in reactive` = stop("error in a reactive in teal_data_module (manual stop call)"),
               `validate error` = validate(need(FALSE, "validate error in teal_data_module (with newline )")),
               `silent.shiny.error` = req(FALSE)
        )
      })
    })
  }
)

trans <- teal_transform_module(
  ui = function(id) {
    ns <- NS(id)
    tagList(
      selectizeInput(
        ns("errortype"),
        label = "Error Type",
        choices = c(
          "ok", "insufficient datasets", "no data",
          "qenv.error", "error in reactive", "validate error", "silent.shiny.error", "not a reactive"
        )
      )
    )
  },
  server = function(id, data) {
    moduleServer(id, function(input, output, session) {
      logger::log_trace("example_module_transform2 initializing.")
      reactive({
        # todo: make sure it triggers once on init
        #       and once on change of its input and once on change in previous stages
        new_data <- switch(input$errortype,
                           ok = data(),
                           `insufficient datasets` = data()["ADSL"],
                           `no data` = teal_data(),
                           qenv.error = within(teal_data(), stop("this is qenv.error in teal_transform_module")),
                           `error in reactive` = stop("error in a reactive in teal_transform_module"),
                           `validate error` = validate(need(FALSE, "validate error in teal_transform_module")),
                           `silent.shiny.error` = req(FALSE)
        )
        new_data
      })
    })
  }
)

empty_ui_trans <- teal_transform_module(
  ui = NULL,
  # server = function(id, data) moduleServer(id, function(input, output, session) reactive(stop("data")))
  server = function(id, data) moduleServer(id, function(input, output, session) data)
)


decor <- function(title_suffix = "Title") {
  teal_transform_module(
    label = sprintf("\"%s\" decorator", title_suffix),
    ui = function(id) {
      ns <- NS(id)
      tagList(
        selectizeInput(
          ns("action"),
          label = "Action type",
          choices = c(
            "nothing", "decorate", "no data",
            "qenv.error", "error in reactive",
            "validate error", "silent.shiny.error",
            "not a reactive"
          )
        )
      )
    },
    server = function(id, data) {
      moduleServer(id, function(input, output, session) {
        logger::log_trace("example_module_transform2 initializing.")
        reactive({
          switch(input$action,
                 "nothing" = data(),
                 "decorate" = data() |> within(plot <- plot + ggplot2::ggtitle(title), title = sprintf("%s %s", data()$plot$labels$title %||% "Decorated", title_suffix)),
                 "no data" = teal_data(),
                 "qenv.error" = within(teal_data(), stop("this is qenv.error in teal_transform_module")),
                 "error in reactive" = stop("error in a reactive in teal_transform_module"),
                 "validate error" = validate(need(FALSE, "Custom validate error in teal_transform_module")),
                 "silent.shiny.error" = req(FALSE)
          )
        })
      })
    }
  )
}

app <- teal::init(
  data = data,
  modules = list(
    tm_decorated_plot(
      "mod-2",
      transformators = list(empty_ui_trans, trans, trans),
      decorators = list(decor("title"), decor("(second) title")),
      datanames = c("ADSL", "ADTTE")
    ),
    tm_decorated_plot(
      "mod-2 (blank)",
      decorators = list(),
      datanames = c("ADSL", "ADTTE")
    ),
    tm_decorated_plot(
      "mod-2 (only decorators)",
      decorators = list(decor("title"), decor("(second) title")),
      datanames = c("ADSL", "ADTTE")
    ),
    tm_decorated_plot(
      "mod-2 (only trans)",
      transformators = list(empty_ui_trans, trans, trans),
      datanames = c("ADSL", "ADTTE")
    )

  ),
  filter = teal_slices(
    teal_slice("ADSL", "SEX"),
    teal_slice("ADSL", "AGE", selected = c(18L, 65L)),
    teal_slice("ADTTE", "PARAMCD", selected = "CRSD"),
    include_varnames = list(
      ADSL = c("SEX", "AGE")
    )
  )
)

runApp(app)

[m7pr]

@averissimo looks really solid