Skip to content

Commit

Permalink
1304 handover error@main (#1341)
Browse files Browse the repository at this point in the history 
Alternative solution to #1330. Closes #1304, #1307, and #1308

1. When teal_data_module fails, then teal-module-tabs are disabled. When
teal_data_module returns teal_data again teal-module-tabs are enabled
2. When reactive data passed directly to srv_teal fails, then the whole
tab-panel is hidden and error message is shown. Warning messages are
displayed over tab-panel.
3. when teal_transform_module fails then following
teal_transform_module(s) show generic message that something was wrong.
Reason for this is the same as (3).
4. when teal_transform_module fails then teal-module output is disabled
and generic failure message is shown in the main panel. We decided to
show a generic failure message as "real failure message" should be only
shown in the place where error occurred to no cause confusion.
5. failing teal_data_module/teal_transform_module fallbacks to previous
valid data (see exaplanation below)

The most important part of the implementation is that when
teal_data_module fails then it return the previous valid data (i.e. it
return unchanged data). This means that failure doesn't trigger
downstream reactivity and we don't need to deal with `data` input as
error. In other words, this implementation halts reactivity when
something goes wrong.
When something goes wrong, teal-module-output is hidden and instead
error message is displayed.

Also, I've moved `data` completely away from `ui` and now if there is
`teal_data_module` then data-tab is added dynamically.

<details>
<summary>app w/ teal_data_module</summary>

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

# pkgload::load_all("teal.data")
pkgload::load_all("teal")

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]
  teal.data::datanames(data_obj) <- datanames
  data_obj
}

trans <- list(
  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({
          switch(input$errortype,
            ok = data(),
            `insufficient datasets` = teal:::.subset_teal_data(data(), "ADSL"),
            `no data` = teal_data(),
            qenv.error = within(teal_data(), stop("\nthis is qenv.error in teal_transform_module\n")),
            `error in reactive` = stop("\nerror in a reactive in teal_transform_module\n"),
            `validate error` = validate(need(FALSE, "\nvalidate error in teal_transform_module\n")),
            `silent.shiny.error` = req(FALSE)
          )
        })
      })
    }
  )
)

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"
        )
      ),
      actionButton(ns("submit"), "Go!")
    )
  },
  server = function(id, ...) {
    moduleServer(id, function(input, output, session) {
      logger::log_trace("example_module_transform2 initializing.")
      eventReactive(input$submit, {
        switch(input$errortype,
          ok = make_data(),
          `insufficient datasets` = make_data(datanames = "ADSL"),
          `no data` = teal_data(),
          qenv.error = within(data(), stop("\nthis is qenv.error in teal_data_module\n")),
          `error in reactive` = stop("\nerror in a reactive in teal_data_module\n"),
          `validate error` = validate(need(FALSE, "\nvalidate error in teal_data_module\n")),
          `silent.shiny.error` = req(FALSE)
        )
      })
    })
  }
)

app <- teal::init(
  data = data,
  modules = list(
    example_module("mod-1", transformers = c(trans, trans, trans), datanames = c("ADSL", "ADTTE")),
    example_module("mod-2", transformers = trans, datanames = c("ADSL", "ADTTE")),
    module(
      label = "I was made to annoy you",
      ui = function(id) NULL,
      server = function(id, data) {
        moduleServer(id, function(input, output, session) {
          observe({
            teal.data::datanames(data())
            ADSL <- data()[["ADSL"]]
            ADSL$AGE
          })

          observeEvent(data(), {
            print(data()[["ADSL"]]$SEX)
          })
        })
      },
      datanames = "ADSL"
    )
  ),
  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)

```

</details>

<details>
<summary>app wrapped</summary>

```r
options(
  teal.log_level = "TRACE",
  teal.show_js_log = TRUE,
  # teal.bs_theme = bslib::bs_theme(version = 5),
  shiny.bookmarkStore = "server"
)
library(scda)
pkgload::load_all("teal")

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]
  teal.data::datanames(data_obj) <- datanames
  data_obj
}

ui_data <- 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"
      )
    ),
    actionButton(ns("submit"), "Go!")
  )
}

srv_data <- function(id, ...) {
  moduleServer(id, function(input, output, session) {
    logger::log_trace("example_module_transform2 initializing.")
    eventReactive(input$submit, {
      switch(input$errortype,
        ok = make_data(),
        `insufficient datasets` = make_data(datanames = "ADSL"),
        `no data` = teal_data(),
        qenv.error = within(data(), stop("\nthis is qenv.error in teal_data_module\n")),
        `error in reactive` = stop("\nerror in a reactive in teal_data_module\n"),
        `validate error` = validate(need(FALSE, "\nvalidate error in teal_data_module\n")),
        `silent.shiny.error` = req(FALSE)
      )
    })
  })
}

modules <- modules(
  teal.modules.general::tm_data_table("Data Table"),
  example_module("Example Module", datanames = "ADTTE"),
  module(
    ui = function(id) {
      ns <- NS(id)
      tagList(
        tableOutput(ns("filter_summary"))
      )
    },
    server = function(id, datasets) {
      moduleServer(id, function(input, output, session) {
        output$filter_summary <- renderTable({
          datasets$get_filter_overview(datanames = datasets$datanames())
        })
      })
    }
  )
)

shinyApp(
  ui = function(request) {
    fluidPage(
      ui_data("data"),
      ui_teal(id = "teal", modules = modules)
    )
  },
  server = function(input, output, session) {
    data_rv <- srv_data("data", data = data, modules = modules)
    srv_teal(id = "teal", data = data_rv, modules = modules)
  }
)

```

</details>

---------

Signed-off-by: Vedha Viyash <[email protected]>
Signed-off-by: Marcin <[email protected]>
Co-authored-by: vedhav <[email protected]>
Co-authored-by: Vedha Viyash <[email protected]>
Co-authored-by: m7pr <[email protected]>
Co-authored-by: Marcin <[email protected]>
Co-authored-by: github-actions <41898282+github-actions[bot]@users.noreply.github.com>
Co-authored-by: 27856297+dependabot-preview[bot]@users.noreply.github.com <27856297+dependabot-preview[bot]@users.noreply.github.com>
  • Loading branch information
@gogonzo @vedhav
@m7pr @github-actions @dependabot-preview
7 people authored Oct 3, 2024
1 parent 2a7d3f9 commit 7683b6f
Show file tree
Hide file tree
Showing 21 changed files with 495 additions and 412 deletions.
1 change: 0 additions & 1 deletion NAMESPACE
View file
Original file line number Diff line number Diff line change
Expand Up @@ -10,7 +10,6 @@ S3method(srv_teal_module,default)
S3method(srv_teal_module,teal_module)
S3method(srv_teal_module,teal_modules)
S3method(ui_teal_module,default)
S3method(ui_teal_module,shiny.tag)
S3method(ui_teal_module,teal_module)
S3method(ui_teal_module,teal_modules)
S3method(within,teal_data_module)
Expand Down
1 change: 0 additions & 1 deletion R/init.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -238,7 +238,6 @@ init <- function(data,
ui = function(request) {
ui_teal(
id = ns("teal"),
data = if (inherits(data, "teal_data_module")) data,
modules = modules,
title = title,
header = header,
Expand Down
13 changes: 11 additions & 2 deletions R/module_filter_data.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -61,7 +61,7 @@ srv_filter_data <- function(id, datasets, active_datanames, data_rv, is_active)
"lockEnvironment(.raw_data) #@linksto .raw_data" # this is environment and it is shared by qenvs. CAN'T MODIFY!
)
)
filtered_code <- teal.slice::get_filter_expr(datasets = datasets, datanames = datanames)
filtered_code <- .get_filter_expr(datasets = datasets, datanames = datanames)
filtered_teal_data <- .append_evaluated_code(data, filtered_code)
filtered_datasets <- sapply(datanames, function(x) datasets$get_data(x, filtered = TRUE), simplify = FALSE)
filtered_teal_data <- .append_modified_data(filtered_teal_data, filtered_datasets)
Expand All @@ -75,7 +75,7 @@ srv_filter_data <- function(id, datasets, active_datanames, data_rv, is_active)
req(inherits(datasets(), "FilteredData"))
new_signature <- c(
teal.data::get_code(data_rv()),
teal.slice::get_filter_expr(datasets = datasets(), datanames = active_datanames())
.get_filter_expr(datasets = datasets(), datanames = active_datanames())
)
if (!identical(previous_signature(), new_signature)) {
previous_signature(new_signature)
Expand All @@ -100,3 +100,12 @@ srv_filter_data <- function(id, datasets, active_datanames, data_rv, is_active)

trigger_data
}

#' @rdname module_filter_data
.get_filter_expr <- function(datasets, datanames) {
if (length(datanames)) {
teal.slice::get_filter_expr(datasets = datasets, datanames = datanames)
} else {
NULL
}
}
110 changes: 29 additions & 81 deletions R/module_init_data.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -25,119 +25,67 @@
#' @inheritParams init
#'
#' @param data (`teal_data`, `teal_data_module`, or `reactive` returning `teal_data`)
#' The `ui` component of this module does not require `data` if `teal_data_module` is not provided.
#' The `data` argument in the `ui` is included solely for the `$ui` function of the
#' `teal_data_module`. Otherwise, it can be disregarded, ensuring that `ui_teal` does not depend on
#' the reactive data of the enclosing application.
#' The data which application will depend on.
#'
#' @return A `reactive` object that returns:
#' - `teal_data` when the object is validated
#' - `shiny.silent.error` when not validated.
#' Output of the `data`. If `data` fails then returned error is handled (after [tryCatch()]) so that
#' rest of the application can respond to this respectively.
#'
#' @rdname module_init_data
#' @name module_init_data
#' @keywords internal
NULL

#' @rdname module_init_data
ui_init_data <- function(id, data) {
ui_init_data <- function(id) {
ns <- shiny::NS(id)
shiny::div(
id = ns("content"),
style = "display: inline-block;",
if (inherits(data, "teal_data_module")) {
ui_teal_data(ns("teal_data_module"), data_module = data)
} else {
NULL
}
style = "display: inline-block; width: 100%;",
uiOutput(ns("data"))
)
}

#' @rdname module_init_data
srv_init_data <- function(id, data, modules, filter = teal_slices()) {
srv_init_data <- function(id, data) {
checkmate::assert_character(id, max.len = 1, any.missing = FALSE)
checkmate::assert_multi_class(data, c("teal_data", "teal_data_module", "reactive", "reactiveVal"))
checkmate::assert_class(modules, "teal_modules")
checkmate::assert_class(filter, "teal_slices")
checkmate::assert_multi_class(data, c("teal_data", "teal_data_module", "reactive"))

moduleServer(id, function(input, output, session) {
logger::log_debug("srv_data initializing.")

if (getOption("teal.show_js_log", default = FALSE)) {
shinyjs::showLog()
}

# data_rv contains teal_data object
# either passed to teal::init or returned from teal_data_module
data_validated <- if (inherits(data, "teal_data_module")) {
srv_teal_data(
"teal_data_module",
data = reactive(req(FALSE)), # to .fallback_on_failure to shiny.silent.error
data_module = data,
modules = modules,
validate_shiny_silent_error = FALSE
)
data_out <- if (inherits(data, "teal_data_module")) {
output$data <- renderUI(data$ui(id = session$ns("teal_data_module")))
data$server("teal_data_module")
} else if (inherits(data, "teal_data")) {
reactiveVal(data)
} else if (test_reactive(data)) {
.fallback_on_failure(this = data, that = reactive(req(FALSE)), label = "Reactive data")
}

if (inherits(data, "teal_data_module")) {
shinyjs::disable(selector = sprintf(".teal-body:has('#%s') .nav li a", session$ns("content")))
data
}

observeEvent(data_validated(), {
showNotification("Data loaded successfully.", duration = 5)
shinyjs::enable(selector = sprintf(".teal-body:has('#%s') .nav li a", session$ns("content")))
if (isTRUE(attr(data, "once"))) {
# Hiding the data module tab.
shinyjs::hide(
selector = sprintf(
".teal-body:has('#%s') a[data-value='teal_data_module']",
session$ns("content")
)
)
# Clicking the second tab, which is the first module.
shinyjs::runjs(
sprintf(
"document.querySelector('.teal-body:has(#%s) .nav li:nth-child(2) a').click();",
session$ns("content")
)
)
}
data_handled <- reactive({
tryCatch(data_out(), error = function(e) e)
})

is_filter_ok <- check_filter_datanames(filter, ls(teal.code::get_env(data_validated())))
if (!isTRUE(is_filter_ok)) {
showNotification(
"Some filters were not applied because of incompatibility with data. Contact app developer.",
type = "warning",
duration = 10
# We want to exclude teal_data_module elements from bookmarking as they might have some secrets
observeEvent(data_handled(), {
if (inherits(data_handled(), "teal_data")) {
app_session <- .subset2(shiny::getDefaultReactiveDomain(), "parent")
setBookmarkExclude(
session$ns(
grep(
pattern = "teal_data_module-",
x = names(reactiveValuesToList(input)),
value = TRUE
)
),
session = app_session
)
warning(is_filter_ok)
}
})

observeEvent(data_validated(), once = TRUE, {
# Excluding the ids from teal_data_module using full namespace and global shiny app session.
app_session <- .subset2(shiny::getDefaultReactiveDomain(), "parent")
setBookmarkExclude(
session$ns(
grep(
pattern = "teal_data_module-",
x = names(reactiveValuesToList(input)),
value = TRUE
)
),
session = app_session
)
})

# Adds signature protection to the datanames in the data
reactive({
req(data_validated())
.add_signature_to_data(data_validated())
})
data_handled
})
}

Expand Down
Loading

0 comments on commit 7683b6f

Please sign in to comment.