diff --git a/R/check_selector.R b/R/check_selector.R index 122f5f4e..406d7c9d 100644 --- a/R/check_selector.R +++ b/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) } diff --git a/R/data_extract_filter_module.R b/R/data_extract_filter_module.R index fe2ad752..e1f40437 100644 --- a/R/data_extract_filter_module.R +++ b/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 - ) - } - ) } ) } diff --git a/R/data_extract_module.R b/R/data_extract_module.R index f77e4443..45ddb0ba 100644 --- a/R/data_extract_module.R +++ b/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 } diff --git a/R/data_extract_select_module.R b/R/data_extract_select_module.R index 63e8c696..627dbf96 100644 --- a/R/data_extract_select_module.R +++ b/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 ) diff --git a/R/data_extract_single_module.R b/R/data_extract_single_module.R index 7250578e..7a4559f7 100644 --- a/R/data_extract_single_module.R +++ b/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)) { diff --git a/tests/testthat/test-data_extract_module.R b/tests/testthat/test-data_extract_module.R index 55df2e99..0345b3bb 100644 --- a/tests/testthat/test-data_extract_module.R +++ b/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