211073 implement user feedback

R/mod_export_listings.R

@@ -49,7 +49,11 @@ mod_export_listings_UI <- function(module_id) { # nolint
     shinyFeedback::useShinyFeedback(), # needed to use shinyFeedback functionalities
     shinyjs::useShinyjs(), # needed to use shinyjs functionalities
 
-    shiny::actionButton(ns(EXP$EXPORTBTN_ID), label = EXP$EXPORTBTN_LABEL)
+    shiny::actionButton(
+      ns(EXP$EXPORTBTN_ID),
+      label = EXP$EXPORTBTN_LABEL,
+      icon = shiny::icon("download")
+    )
   )
 
   return(ui)

R/mod_listings.R

@@ -9,7 +9,15 @@ TBL <- pack_of_constants( # nolint
   DRPDBUTTON_LABEL = "Click to see inputs",
   TABLE_ID = "listing",
   NO_COL_MSG = "Please select at least one column.",
-  EXPORT_ID = "export"
+  EXPORT_ID = "export",
+  RESET_FILT_BUTTON_ID = "reset_filt_btn",
+  RESET_FILT_BUTTON_LABEL = "Reset all filters",
+  SELECT_ALL_COLS_BUTTON_ID = "select_all_cols_btn",
+  SELECT_ALL_COLS_BUTTON_LABEL = "Select all variables",
+  REMOVE_ALL_COLS_BUTTON_ID = "remove_all_cols_btn",
+  REMOVE_ALL_COLS_BUTTON_LABEL = "Remove all variables",
+  RESET_COLS_DEFAULT_BUTTON_ID = "reset_cols_btn",
+  RESET_COLS_DEFAULT_BUTTON_LABEL = "Reset to default variables"
 )
 
 #' A module that displays datasets as listings
@@ -29,26 +37,43 @@ listings_UI <- function(module_id) { # nolint
 
   shiny::tagList(
     shiny::fluidRow(
-      shiny::column(2, shinyWidgets::dropdownButton(
-        inputId = ns(TBL$DRPDBUTTON_ID),
-        shiny::selectizeInput(ns(TBL$DATASET_ID), label = TBL$DATASET_LABEL, choices = NULL),
-        shiny::selectizeInput(
-          ns(TBL$COLUMNS_ID),
-          label = TBL$COLUMNS_LABEL,
-          choices = NULL,
-          multiple = TRUE,
-          options = list(plugins = list("remove_button", "drag_drop"))
-        ),
-        circle = FALSE,
-        icon = shiny::icon("cog"),
-        width = TBL$DRPDBUTTON_WIDTH,
-        label = TBL$DRPDBUTTON_LABEL,
-        tooltip = shinyWidgets::tooltipOptions(title = TBL$DRPDBUTTON_LABEL)
-      )),
+      shiny::column(
+        2,
+        shinyWidgets::dropdownButton(
+          inputId = ns(TBL$DRPDBUTTON_ID),
+          shiny::selectizeInput(ns(TBL$DATASET_ID), label = TBL$DATASET_LABEL, choices = NULL),
+          shiny::tags[["style"]](shiny::HTML(paste0(
+            "#",
+            ns(TBL$COLUMNS_ID),
+            " + div.selectize-control div.selectize-input.items {max-height:200px; overflow-y:auto;}"
+          ))),
+          shiny::selectizeInput(
+            ns(TBL$COLUMNS_ID),
+            label = TBL$COLUMNS_LABEL,
+            choices = NULL,
+            multiple = TRUE,
+            options = list(plugins = list("remove_button", "drag_drop"))
+          ),
+          shiny::actionButton(ns(TBL$SELECT_ALL_COLS_BUTTON_ID), TBL$SELECT_ALL_COLS_BUTTON_LABEL),
+          shiny::actionButton(ns(TBL$REMOVE_ALL_COLS_BUTTON_ID), TBL$REMOVE_ALL_COLS_BUTTON_LABEL),
+          shiny::actionButton(ns(TBL$RESET_COLS_DEFAULT_BUTTON_ID), TBL$RESET_COLS_DEFAULT_BUTTON_LABEL),
+          circle = FALSE,
+          icon = shiny::icon("cog"),
+          width = TBL$DRPDBUTTON_WIDTH,
+          label = TBL$DRPDBUTTON_LABEL,
+          tooltip = shinyWidgets::tooltipOptions(title = TBL$DRPDBUTTON_LABEL)
+        )
+      ),
       shiny::column(2, mod_export_listings_UI(module_id = ns(TBL$EXPORT_ID)), offset = 8)
     ),
     shiny::br(),
-    DT::dataTableOutput(ns(TBL$TABLE_ID), height = "80vh")
+    shiny::actionButton(
+      ns(TBL$RESET_FILT_BUTTON_ID),
+      TBL$RESET_FILT_BUTTON_LABEL,
+      icon = shiny::icon("filter-circle-xmark")
+    ),
+    shiny::br(),
+    DT::dataTableOutput(ns(TBL$TABLE_ID), height = "80vh"),
   )
 }
 
@@ -102,6 +127,9 @@ listings_server <- function(module_id,
       dataset_list()
     })
 
+    # Set choices as a reactive value item
+    rvs <- shiny::reactiveValues(dataset_choices = NA, variable_choices = NA)
+
     # Listing selection (start)
     shiny::observeEvent(v_dataset_list(), {
       # Fill default in case bookmark or default columns do not have all the listings in the dataset
@@ -114,10 +142,10 @@ listings_server <- function(module_id,
       }
       bmk_dataset <<- NULL
 
-      choices <- generate_choices(v_dataset_list())
-      shiny::exportTestValues(dataset_choices = choices) # Export values for shinytest2  tests
+      rvs$dataset_choices <- generate_choices(v_dataset_list())
+      shiny::exportTestValues(dataset_choices = rvs$dataset_choices) # Export values for shinytest2  tests
 
-      shiny::updateSelectizeInput(inputId = TBL$DATASET_ID, choices = choices, selected = selected)
+      shiny::updateSelectizeInput(inputId = TBL$DATASET_ID, choices = rvs$dataset_choices, selected = selected)
     })
 
     listings_data <- shiny::reactive({
@@ -146,19 +174,49 @@ listings_server <- function(module_id,
           )
         }
 
-        choices <- generate_choices(listings_data())
+        rvs$variable_choices <- generate_choices(listings_data())
 
         shiny::updateSelectizeInput(
           inputId = TBL$COLUMNS_ID,
-          choices = choices,
+          choices = rvs$variable_choices,
           selected = r_selected_columns_in_dataset()[[input[[TBL$DATASET_ID]]]]
         )
       }
     )
 
+    shiny::observeEvent(input[[TBL$SELECT_ALL_COLS_BUTTON_ID]], {
+      shiny::updateSelectizeInput(
+        inputId  = TBL$COLUMNS_ID,
+        choices  = rvs$variable_choices,
+        selected = rvs$variable_choices
+      )
+    })
+
+    shiny::observeEvent(input[[TBL$REMOVE_ALL_COLS_BUTTON_ID]], {
+      shiny::updateSelectizeInput(
+        inputId  = TBL$COLUMNS_ID,
+        choices  = rvs$variable_choices,
+        selected = NULL
+      )
+    })
+
+    shiny::observeEvent(input[[TBL$RESET_COLS_DEFAULT_BUTTON_ID]], {
+      r_selected_columns_in_dataset(
+        fill_default_vars(default_vars, v_dataset_list())
+      )
+      shiny::updateSelectizeInput(
+        inputId  = TBL$COLUMNS_ID,
+        choices  = rvs$variable_choices,
+        selected = r_selected_columns_in_dataset()[[input[[TBL$DATASET_ID]]]]
+      )
+    })
+
+
     shiny::observeEvent(input[[TBL$COLUMNS_ID]], {
       selected_columns_in_dataset <- r_selected_columns_in_dataset()
-      selected_columns_in_dataset[[input[[TBL$DATASET_ID]]]] <- input[[TBL$COLUMNS_ID]]
+      selected_columns_in_dataset[[input[[TBL$DATASET_ID]]]] <- input[[
+        TBL$COLUMNS_ID
+      ]]
       r_selected_columns_in_dataset(selected_columns_in_dataset)
     })
 
@@ -205,6 +263,10 @@ listings_server <- function(module_id,
       intended_use_label = intended_use_label
     )
 
+    # Proxy reference to dataTable
+    dt_proxy <- DT::dataTableProxy(TBL$TABLE_ID)
+    shiny::observeEvent(input[[TBL$RESET_FILT_BUTTON_ID]], DT::clearSearch(dt_proxy))
+
     output[[TBL$TABLE_ID]] <- DT::renderDataTable({
       shiny::validate(shiny::need(!is.null(input[[TBL$COLUMNS_ID]]), TBL$NO_COL_MSG))
 
@@ -251,7 +313,13 @@ listings_server <- function(module_id,
           ordering = TRUE,
           columnDefs = list(list(className = "dt-center", targets = "_all")),
           dom = "Bfrtilp",
-          buttons = list(list(extend = "collection", text = "Reset Rows Order", action = htmlwidgets::JS(js)))
+          buttons = list(
+            list(
+              extend = "collection",
+              text = "Reset rows order",
+              action = htmlwidgets::JS(js)
+            )
+          )
         )
       )
     })

tests/testthat/test-mod_listing.R

@@ -454,30 +454,36 @@ test_that("mock_table_mm() updates dropdown choices on dataset change in dv.mana
   app <- shinytest2::AppDriver$new(
     app_dir = app_dir, name = "test_update_labels"
   )
+  app$wait_for_idle()
+
+  app$set_inputs(selector = "demo", wait_ = FALSE)
+  app$wait_for_idle()
 
   expected <- c(
     "adsl [Subject Level]" = "adsl",
     "adae [Adverse Events]" = "adae",
     "small [Few columns]" = "small"
   )
-
   actual <- app$get_value(export = "multi-dataset_choices")
 
-  # Verify that dataset choices are displayed properly with their labels
+  actual <- app$wait_for_value(
+    export = "multi-dataset_choices", ignore = list(NULL), timeout = 5e3
+  )
   testthat::expect_equal(actual, expected = expected)
 
-  # Switch overall dataset (via module manager)
-  app$set_inputs(selector = "demo no labels")
+  app$set_inputs(selector = "demo no labels") # Switch overall dataset (via module manager)
+  app$click("multi-dropdown_btn")
+  app$set_inputs(`multi-dropdown_btn_state` = TRUE)
 
   expected <- c(
     "adsl [No label]" = "adsl",
     "adae [No label]" = "adae",
     "small [No label]" = "small"
   )
-
-  actual <- app$get_value(export = "multi-dataset_choices")
-
-  # Verify that dataset choices were updated due to dataset switch
+  actual <- app$wait_for_value(
+    export = "multi-dataset_choices", ignore = list(actual), timeout = 10e3
+  )
+  app$stop()
   testthat::expect_equal(actual, expected = expected)
 }) # integration
 
@@ -513,6 +519,7 @@ test_that("mock_table_mm() displays selected columns after activating global fil
   # Set selected columns
   selected_cols <- c("STUDYID", "USUBJID")
   app$set_inputs(`multi-col_sel` = selected_cols)
+  app$wait_for_idle()
 
   # Activate global filter
   app$set_inputs(`global_filter-vars` = "RACE")
@@ -545,3 +552,112 @@ test_that("mock_table_mm() displays selected dataset after activating global fil
 
   testthat::expect_equal(actual, expected = selected)
 }) # integration
+
+
+test_that("mock_table_mm() displays selected dataset after activating global filter", {
+  # Initialize test app
+  app <- shinytest2::AppDriver$new(
+    app_dir = app_dir, name = "test_global_filter_selected_dataset"
+  )
+
+  selected <- "adae"
+  # Switch dataset
+  app$set_inputs(`multi-dataset` = selected)
+  app$wait_for_idle()
+
+  # Activate global filter
+  app$set_inputs(`global_filter-vars` = "RACE")
+  app$wait_for_idle()
+
+  actual <- app$get_value(input = "multi-dataset")
+
+  # Kill test app
+  app$stop()
+
+  testthat::expect_equal(actual, expected = selected)
+}) # integration
+
+app_dir <- "./apps/listings_app" # applies for all tests within this describe()
+app <- shinytest2::AppDriver$new(app_dir = app_dir, name = "test_listings_app")
+app_dir <- app$get_url()
+
+test_that("Check select all columns works correctly", {
+  app <- shinytest2::AppDriver$new(
+    app_dir = app_dir, name = "test_select_all_columns"
+  )
+
+  # SET INITIAL DATASET
+  app$click("listings-dropdown_btn")
+  app$set_inputs(`listings-dropdown_btn_state` = TRUE, wait_ = FALSE)
+  app$set_inputs(`listings-dataset` = "dummy1", wait_ = FALSE) # set to simple_dummy data
+
+  # CHECK ALL COLS SELECTED
+  app$click("listings-select_all_cols_btn")
+  actual <- app$get_value(input = "listings-col_sel")
+  app$stop()
+
+  expected <- names(simple_dummy)
+  testthat::expect_equal(actual, expected)
+}) # integration
+
+test_that("Check unselect all columns works correctly", {
+  app <- shinytest2::AppDriver$new(
+    app_dir = app_dir, name = "test_unselect_all_columns"
+  )
+
+  # SET INITIAL DATASET
+  app$click("listings-dropdown_btn")
+  app$set_inputs(`listings-dropdown_btn_state` = TRUE, wait_ = FALSE)
+  app$set_inputs(`listings-dataset` = "dummy1", wait_ = FALSE) # set to simple_dummy data
+
+  # CHECK ALL COLS UNSELECTED
+  app$click("listings-remove_all_cols_btn")
+  actual <- app$get_value(input = "listings-col_sel")
+  app$stop()
+  testthat::expect_null(actual)
+}) # integration
+
+test_that("Check reset all columns works correctly", {
+  app <- shinytest2::AppDriver$new(
+    app_dir = app_dir, name = "test_reset_columns"
+  )
+
+  # SET INITIAL DATASET
+  app$click("listings-dropdown_btn")
+  app$set_inputs(`listings-dropdown_btn_state` = TRUE, wait_ = FALSE)
+  app$set_inputs(`listings-dataset` = "dummy1", wait_ = FALSE) # set to simple_dummy data
+
+  # CHECK COLS RESET TO DEFAULT VARS
+  app$click("listings-reset_cols_btn")
+  actual <- app$get_value(input = "listings-col_sel")
+  app$stop()
+  expected <- names(simple_dummy)[1:3]
+
+  testthat::expect_equal(actual, expected)
+}) # integration
+
+test_that("Check reset filters works correctly", {
+  app <- shinytest2::AppDriver$new(
+    app_dir = app_dir, name = "test_reset_filters"
+  )
+
+  # SET INITIAL DATASET
+  app$click("listings-dropdown_btn")
+  app$set_inputs(`listings-dropdown_btn_state` = TRUE, wait_ = FALSE)
+  app$set_inputs(`listings-dataset` = "dummy1", wait_ = FALSE) # set to simple_dummy data
+  expected <- app$wait_for_value(
+    output = "listings-listing", ignore = list(NULL), timeout = 800
+  )
+
+  # SET COL FILTERS
+  app$set_inputs(
+    `listings-listing_search_columns` = c("4 ... 31", "23 ... 48", "2 ... 30"),
+    allow_no_input_binding_ = TRUE
+  )
+
+  # PRESS RESET FILT BUTTON
+  app$click("listings-reset_filt_btn")
+  actual <- app$get_value(output = "listings-listing")
+
+  testthat::expect_equal(actual, expected)
+}) # integration