898 save app state version 3

R/check_selector.R

@@ -111,7 +111,7 @@ check_selector <- function(selector) {
       check_selector_reshape(selector$reshape)
       check_selector_internal_id(selector$internal_id)
     },
-    error = function(e) shiny::validate(e$message)
+    error = function(e) validate(e$message)
   )
   invisible(selector)
 }

R/data_extract_filter_module.R

@@ -16,28 +16,10 @@ data_extract_filter_ui <- function(filter, id = "filter") {
 
   ns <- NS(id)
 
-  html_col <- teal.widgets::optionalSelectInput(
-    inputId = ns("col"),
-    label = `if`(inherits(filter, "delayed_filter_spec"), NULL, filter$vars_label),
-    choices = `if`(inherits(filter, "delayed_filter_spec"), NULL, filter$vars_choices),
-    selected = `if`(inherits(filter, "delayed_filter_spec"), NULL, filter$vars_selected),
-    multiple = filter$vars_multiple,
-    fixed = filter$vars_fixed
-  )
-
-  html_vals <- teal.widgets::optionalSelectInput(
-    inputId = ns("vals"),
-    label = filter$label,
-    choices = `if`(inherits(filter, "delayed_filter_spec"), NULL, filter$choices),
-    selected = `if`(inherits(filter, "delayed_filter_spec"), NULL, filter$selected),
-    multiple = filter$multiple,
-    fixed = filter$fixed
-  )
-
   tags$div(
     class = "filter_spec",
-    if (filter$vars_fixed) shinyjs::hidden(html_col) else html_col,
-    html_vals
+    uiOutput(ns("col_container")),
+    uiOutput(ns("vals_container"))
   )
 }
 
@@ -66,66 +48,68 @@ data_extract_filter_srv <- function(id, datasets, filter) {
       force(filter)
       logger::log_trace("data_extract_filter_srv initialized with: { filter$dataname } dataset.")
 
-      isolate({
-        # when the filter is initialized with a delayed spec, the choices and selected are NULL
-        # here delayed are resolved and the values are set up
+      ns <- session$ns
+
+      output$col_container <- renderUI({
+        logger::log_trace("data_extract_filter_srv@1 setting up filter col input")
+        teal.widgets::optionalSelectInput(
+          inputId = ns("col"),
+          label = filter$vars_label,
+          choices = filter$vars_choices,
+          selected = filter$vars_selected,
+          multiple = filter$vars_multiple,
+          fixed = filter$vars_fixed
+        )
+      })
+
+      is_init <- reactiveVal(TRUE)
+      vals_options <- reactive({
+        req(input$col)
+        choices <- value_choices(
+          data = datasets[[filter$dataname]](),
+          var_choices = input$col,
+          var_label = if (isTRUE(input$col == attr(filter$choices, "var_choices"))) attr(filter$choices, "var_label")
+        )
+        selected <- if (shiny::isolate(is_init())) {
+          shiny::isolate(is_init(FALSE))
+          restoreInput(ns("vals"), filter$selected)
+        } else if (filter$multiple) {
+          choices
+        } else {
+          choices[1L]
+        }
+        list(choices = choices, selected = selected)
+      })
+
+      output$vals_container <- renderUI({
+        logger::log_trace("data_extract_filter_srv@2 updating filter vals")
+        teal.widgets::optionalSelectInput(
+          inputId = ns("vals"),
+          label = filter$label,
+          choices = vals_options()$choices,
+          selected = vals_options()$selected,
+          multiple = filter$multiple,
+          fixed = filter$fixed
+        )
+      })
+
+      # Since we want the input$vals to depend on input$col for downstream calculations,
+      # we trigger reactivity by reassigning them. Otherwise, when input$col is changed without
+      # a change in input$val, the downstream computations will not be triggered.
+      observeEvent(input$col, {
         teal.widgets::updateOptionalSelectInput(
           session = session,
-          inputId = "col",
-          choices = filter$vars_choices,
-          selected = filter$vars_selected
+          inputId = "vals",
+          choices = "",
+          selected = ""
         )
         teal.widgets::updateOptionalSelectInput(
           session = session,
           inputId = "vals",
-          choices = filter$choices,
-          selected = filter$selected
+          choices = vals_options()$choices,
+          selected = vals_options()$selected
         )
       })
-
-      observeEvent(
-        input$col,
-        ignoreInit = TRUE, # When observeEvent is initialized input$col is still NULL as it is set few lines above
-        ignoreNULL = FALSE, # columns could be NULL, then vals should be set to NULL also
-        handlerExpr = {
-          if (!rlang::is_empty(input$col)) {
-            choices <- value_choices(
-              datasets[[filter$dataname]](),
-              input$col,
-              `if`(isTRUE(input$col == attr(filter$choices, "var_choices")), attr(filter$choices, "var_label"), NULL)
-            )
-
-            selected <- if (!is.null(filter$selected)) {
-              filter$selected
-            } else if (filter$multiple) {
-              choices
-            } else {
-              choices[1]
-            }
-          } else {
-            choices <- character(0)
-            selected <- character(0)
-          }
-          dn <- filter$dataname
-          fc <- paste(input$col, collapse = ", ")
-          logger::log_trace("data_extract_filter_srv@1 filter dataset: { dn }; filter var: { fc }.")
-          # In order to force reactivity we run two updates: (i) set up dummy values (ii) set up appropriate values
-          # It's due to a missing reactivity triggers if new selected value is identical with previously selected one.
-          teal.widgets::updateOptionalSelectInput(
-            session = session,
-            inputId = "vals",
-            choices = paste0(input$val, "$_<-_random_text_to_ensure_val_will_be_different_from_previous"),
-            selected = paste0(input$val, "$_<-_random_text_to_ensure_val_will_be_different_from_previous")
-          )
-
-          teal.widgets::updateOptionalSelectInput(
-            session = session,
-            inputId = "vals",
-            choices = choices,
-            selected = selected
-          )
-        }
-      )
     }
   )
 }

R/data_extract_module.R

@@ -210,7 +210,7 @@ data_extract_ui <- function(id, label, data_extract_spec, is_single_dataset = FA
 #'
 check_data_extract_spec_react <- function(datasets, data_extract) {
   if (!all(unlist(lapply(data_extract, `[[`, "dataname")) %in% datasets$datanames())) {
-    shiny::validate(
+    validate(
       "Error in data_extract_spec setup:\
         Data extract spec contains datasets that were not handed over to the teal app."
     )
@@ -254,7 +254,7 @@ check_data_extract_spec_react <- function(datasets, data_extract) {
     }
   ))
 
-  if (!is.null(column_return)) shiny::validate(unlist(column_return))
+  if (!is.null(column_return)) validate(unlist(column_return))
   NULL
 }
 

R/data_extract_select_module.R

@@ -18,8 +18,8 @@ data_extract_select_ui <- function(select, id = "select") {
     teal.widgets::optionalSelectInput(
       inputId = id,
       label = select$label,
-      choices = `if`(inherits(select, "delayed_select_spec"), NULL, select$choices),
-      selected = `if`(inherits(select, "delayed_select_spec"), NULL, select$selected),
+      choices = select$choices,
+      selected = select$selected,
       multiple = select$multiple,
       fixed = select$fixed
     )

R/data_extract_single_module.R

@@ -34,16 +34,7 @@ data_extract_single_ui <- function(id = NULL, single_data_extract_spec) {
   )
 
   ## select input
-  extract_spec_select <- single_data_extract_spec$select
-  if (!is.null(extract_spec_select$fixed)) {
-    attr(extract_spec_select$fixed, which = "dataname") <- single_data_extract_spec$dataname
-  }
-
-  select_display <- if (is.null(extract_spec_select)) {
-    NULL
-  } else {
-    data_extract_select_ui(extract_spec_select, id = ns("select"))
-  }
+  select_display <- uiOutput(ns("select_container"))
 
   ## reshape input
   extract_spec_reshape <- single_data_extract_spec$reshape
@@ -78,16 +69,25 @@ data_extract_single_srv <- function(id, datasets, single_data_extract_spec) {
     function(input, output, session) {
       logger::log_trace("data_extract_single_srv initialized with dataset: { single_data_extract_spec$dataname }.")
 
+      ns <- session$ns
+
       # ui could be initialized with a delayed select spec so the choices and selected are NULL
       # here delayed are resolved
-      isolate({
-        resolved <- resolve_delayed(single_data_extract_spec, datasets)
-        teal.widgets::updateOptionalSelectInput(
-          session = session,
-          inputId = "select",
-          choices = resolved$select$choices,
-          selected = resolved$select$selected
-        )
+      resolved <- isolate({
+        resolve_delayed(single_data_extract_spec, datasets)
+      })
+
+      output$select_container <- renderUI({
+        extract_spec_select <- resolved$select
+        if (!is.null(extract_spec_select$fixed)) {
+          attr(extract_spec_select$fixed, which = "dataname") <- resolved$dataname
+        }
+
+        select_display <- if (is.null(extract_spec_select)) {
+          NULL
+        } else {
+          data_extract_select_ui(extract_spec_select, id = ns("select"))
+        }
       })
 
       for (idx in seq_along(resolved$filter)) {

tests/testthat/test-data_extract_module.R

@@ -23,11 +23,18 @@ testthat::test_that("Single filter", {
 
   testthat::expect_silent(input <- data_extract_single_ui(id = NULL, data_extract))
   testthat::expect_silent(filter <- input$children[[1]])
-  testthat::expect_equal(filter$children[[1]]$children[[1]]$attribs, list(class = "shinyjs-hide"))
-
   testthat::expect_equal(
-    filter$children[[1]]$children[[2]]$children[[4]]$children[[1]]$children[[1]]$children[[2]]$attribs$multiple,
-    "multiple"
+    lapply(filter$children[[1]]$children, `[[`, "attribs"),
+    list(
+      list(
+        id = "filter1-col_container",
+        class = "shiny-html-output"
+      ),
+      list(
+        id = "filter1-vals_container",
+        class = "shiny-html-output"
+      )
+    )
   )
 
   # more tests - check levels of filtered variables