Updated ui functions unit tests

.circleci/config.yml

@@ -9,14 +9,14 @@ workflows:
   version: 2
   Prepare-All-R-Editions:
     jobs:
-      - Build-for-r4_0_5
+      - Build-for-r4_2_0
       - Build-for-rLATEST
 
 jobs:
 
-  Build-for-r4_0_5:
+  Build-for-r4_2_0:
     docker:
-      - image: rocker/verse:4.0.5
+      - image: rocker/verse:4.2
 
     steps:
       - checkout
@@ -34,12 +34,11 @@ jobs:
       - run:
           name: Install R dependencies
           command: |
-            R -e 'install.packages("shiny", repos = "https://cran.rstudio.com/")'
-            R -e 'install.packages("bs4Dash", repos = "https://cran.rstudio.com/")'
             R -e 'install.packages(c("shinyWidgets", "yaml", "DT", "writexl", "fresh", "miniUI", "shinyFeedback"))'
-            R -e 'install.packages(c("canvasXpress", "waiter", "shinyjs", "openxlsx", "spelling", "colourpicker", "lifecycle"))'
+            R -e 'install.packages(c("canvasXpress", "waiter", "shinyjs", "openxlsx",  "openxlsx2", "spelling", "colourpicker", "lifecycle"))'
+            R -e 'install.packages("covr")'
             R -e 'install.packages("reactable")'
-            R -e 'install.packages("openxlsx2", repos = "https://cloud.r-project.org")'
+            R -e 'install.packages("bs4Dash", repos = "https://cran.rstudio.com/")'
 
       - run:
           name: Session information and installed package versions
@@ -61,6 +60,7 @@ jobs:
             R CMD check *tar.gz
 
 
+
   Build-for-rLATEST:
     docker:
       - image: rocker/verse:latest

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: periscope2
 Type: Package
 Title: Enterprise Streamlined 'shiny' Application Framework Using 'bs4Dash'
-Version: 0.3.1.9000
+Version: 0.4.0.9001
 Authors@R: c(
     person("Mohammed", "Ali",      role = c("aut", "cre"), email   = "mohammed@aggregate-genius.com"),
     person("Constance", "Brett",   role = c("ctb")),
@@ -18,7 +18,7 @@ License: GPL-3
 Encoding: UTF-8
 Language: en-US
 Depends:
-    R (>= 4.0)
+    R (>= 4.2)
 Imports:
     shiny (>= 1.7),
     bs4Dash (>= 2.3),
@@ -52,3 +52,4 @@ Suggests:
     waiter
 VignetteBuilder: knitr
 Roxygen: list(markdown = TRUE)
+StagedInstall: no

NEWS.md

@@ -1,4 +1,7 @@
-# periscope2 0.3.1
+# periscope2 0.4.0
+
+## New Features
+- Bumped minimum R version to 4.2 to keep up with modern shiny/promises/httr2/testthat.
 
 ## Enhancements
 

R/downloadableReactTable.R

@@ -217,12 +217,16 @@ downloadableReactTable <- function(id,
                                    logger             = NULL) {
         shiny::moduleServer(id,
              function(input, output, session) {
+                 downloadable_module_state <- shiny::reactiveVal(list(selected_rows = NULL, table_state = NULL))
+                 is_stale                  <- shiny::reactiveVal(FALSE)
+
                  if (is.null(table_data) || !is.function(table_data)) {
                      logerror("'table_data' parameter must be a function or reactive expression.", logger = logger)
                      output$reactTableOutputID <- reactable::renderReactable({ NULL })
                  } else {
                      table_react_params <- shiny::reactiveValues(table_data        = NULL,
                                                                  pre_selected_rows = NULL)
+
                      if (is.null(file_name_root)) {
                          logwarn("'file_name_root' parameter should not be NULL. Setting default value 'data_file'.", logger = logger)
                          file_name_root <- "data_file"
@@ -243,7 +247,9 @@ downloadableReactTable <- function(id,
                          pre_selected_rows <- NULL
                      }
 
-                     shiny::observe({
+                     shiny::observeEvent(table_data(), {
+                         is_stale(TRUE)
+
                          if (!is.data.frame(table_data())) {
                              table_data <- shiny::reactiveVal(data.frame(table_data()))
                          }
@@ -256,7 +262,7 @@ downloadableReactTable <- function(id,
 
                          }
                          shiny::outputOptions(output, "displayButton", suspendWhenHidden = FALSE)
-                     })
+                     }, priority = 10)
 
                      shiny::observe({
                          table_react_params$pre_selected_rows <- NULL
@@ -351,14 +357,35 @@ downloadableReactTable <- function(id,
                          table_output
                     })
                  }
-                 shiny::reactive({
+                 shiny::observe({
+
                      table_state   <- reactable::getReactableState("reactTableOutputID")
                      selected_rows <- NULL
-                     if (!is.null(table_state) && !is.null(table_state$selected) && is.data.frame(table_data())) {
-                         selected_rows <- table_data()[table_state$selected, ]
+
+                     # data is just re/set and new react state is not ready yet
+                     if (is_stale()) {
+                         # If the state is NULL or empty, it means the browser just finished resetting.
+                         # We can turn off the stale flag.
+                         if (is.null(table_state) || is.null(table_state$selected)) {
+                             is_stale(FALSE)
+                            if (!is.null(table_react_params) && !is.null(table_react_params$pre_selected_rows) && is.data.frame(table_data())) {
+                                selected_rows <- table_data()[table_react_params$pre_selected_rows, ]
+                            }
+                         }
+
+                         downloadable_module_state(list(selected_rows = selected_rows, table_state = NULL))
+
+                     } else { # the table is rendered, get the state directly from react table
+                         if (!is.null(table_state)) {
+                             if (!is.null(table_state$selected) && is.data.frame(table_data())) {
+                                 selected_rows <- table_data()[table_state$selected, ]
+                             }
+                             downloadable_module_state(list(selected_rows = selected_rows, table_state = table_state))
+                         }
                      }
-                     list(selected_rows = selected_rows, table_state = table_state)
                  })
+
+                 downloadable_module_state
             }
         )
 }

tests/testthat/_snaps/log_viewer.md

@@ -23,7 +23,3 @@
     <div class="reactable html-widget html-widget-output shiny-report-size html-fill-item" data-reactable-output="myid-myid-reactTableOutputID" id="myid-myid-reactTableOutputID" style="width:auto;height:auto;"></div>
 
 
-# logViewer - valid sample log
-
-    {"x":{"tag":{"name":"Reactable","attribs":{"data":{"action":["Be Sure to Remember to Log ALL user actions","Sample Title (click for an info pop-up) started with log level <DEBUG>","Application Reset requested by user.  Resetting in  5 seconds"],"time":["02-19-2022 14:03","02-19-2022 14:03","02-19-2022 14:04"]},"columns":[{"id":"action","name":"action","type":"character"},{"id":"time","name":"time","type":"character"}],"searchable":true,"pagination":false,"highlight":true,"striped":true,"height":"600px","dataKey":"b624cab69fef11e8d7efb72689e14787","static":false},"children":[]},"class":"reactR_markup"},"evals":[],"jsHooks":[],"deps":[]} 
-

tests/testthat/_snaps/ui_functions.md

@@ -419,7 +419,7 @@
             <img alt="Working..." hspace="5px" src="img/loader.gif"/>
           </div>
           <div id="app_header">
-            <a id="app_info" href="#" class="action-button">periscope Example Application</a>
+            <a id="app_info" href="#" class="action-button action-link"><span class="action-label">periscope Example Application</span></a>
           </div>
         </div>
         <ul class="navbar-nav ml-auto navbar-right">

tests/testthat/test_download_file.R

@@ -3,14 +3,22 @@ local_edition(3)
 
 # helper functions
 download_plot <- function() {
-    ggplot2::ggplot(data = mtcars, aes(x = wt, y = mpg)) +
+    plot <- ggplot2::ggplot(data = mtcars, aes(x = wt, y = mpg)) +
         geom_point(aes(color = cyl)) +
-        theme(legend.justification   = c(1, 1),
-              legend.position.inside = c(1, 1),
-              legend.title           = element_blank()) +
         ggtitle("GGPlot Example w/Hover") +
         xlab("wt") +
         ylab("mpg")
+    if (packageVersion("ggplot2") >= "3.5.0") {
+        plot <- plot +
+            theme(legend.justification   = c(1, 1),
+                  legend.position.inside = c(1, 1),
+                  legend.title           = element_blank())
+    } else {
+        plot <- plot +
+            theme(legend.justification = c(1, 1),
+                  legend.position      = c(1, 1),
+                  legend.title         = element_blank())
+    }
 }
 
 download_lattice_plot <- function() {

tests/testthat/test_downloadable_plot.R

@@ -103,14 +103,22 @@ test_that("downloadablePlotUI invalid btn_valign", {
 
 
 download_plot <- function() {
-    ggplot2::ggplot(data = download_data(), aes(x = wt, y = mpg)) +
+    plot <- ggplot2::ggplot(data = mtcars, aes(x = wt, y = mpg)) +
         geom_point(aes(color = cyl)) +
-        theme(legend.justification   = c(1, 1),
-              legend.position.inside = c(1, 1),
-              legend.title           = element_blank()) +
         ggtitle("GGPlot Example w/Hover") +
         xlab("wt") +
         ylab("mpg")
+    if (packageVersion("ggplot2") >= "3.5.0") {
+        plot <- plot +
+            theme(legend.justification   = c(1, 1),
+                  legend.position.inside = c(1, 1),
+                  legend.title           = element_blank())
+    } else {
+        plot <- plot +
+            theme(legend.justification = c(1, 1),
+                  legend.position      = c(1, 1),
+                  legend.title         = element_blank())
+    }
 }
 
 download_data <- function() {

tests/testthat/test_downloadable_react_table.R

@@ -408,19 +408,25 @@ test_that("downloadableReactTable - module return", {
    })
 
     local_mocked_bindings(
-        getReactableState = function(...) {
-         list(data            = get_mtcars_data(),
-              showSortable    = TRUE,
-              defaultSelected = c(2, 3),
-              selected        = c(2, 3))
-        },
+        getReactableState = function(...) NULL,
         .package = "reactable")
 
 
     testServer(
         downloadableReactTable,
-        args = list(table_data = get_mtcars_data),
+        args = list(
+            table_data        = get_mtcars_data,
+            selection_mode    = "multiple",
+            pre_selected_rows = reactive(c(2, 3))
+        ),
         expr = {
+            # Simulate two reactive ticks:
+            # Tick 1: table_data changes; reactable hasn't reported state yet
+            #         → module falls back to pre_selected_rows
+            # Tick 2: reactable state still NULL; assert fallback value survives
+            session$flushReact()
+            is_stale(TRUE)
+            session$flushReact()
             result <- session$returned()
             expect_equal(length(result), 2)
             expect_true(all(c("selected_rows", "table_state") %in% names(result)))
@@ -431,3 +437,41 @@ test_that("downloadableReactTable - module return", {
 })
 
 
+test_that("downloadableReactTable - returns selected rows from reactable state", {
+    skip_if(getRversion() < "4.1.0", "Skipping due to lifecycle warnings in R < 4.1.0")
+
+    local_mocked_bindings(
+        getReactableState = function(...) {
+            list(showSortable = TRUE,
+                 selected     = c(2, 3))
+        },
+        .package = "reactable")
+
+    testServer(
+        downloadableReactTable,
+        args = list(
+            table_data     = get_mtcars_data,
+            selection_mode = "multiple"
+        ),
+        expr = {
+            # Tick 1: observeEvent(table_data) sets is_stale=TRUE.
+            #         Final observer runs, sees stale + selected non-NULL,
+            #         so it does NOT enter the reset branch and is_stale stays TRUE.
+            session$flushReact()
+
+            # Manually flip is_stale to FALSE to simulate the point in time
+            # after reactable has rendered and reported its state.
+            is_stale(FALSE)
+            session$flushReact()
+
+            result <- session$returned()
+
+            expect_equal(length(result), 2)
+            expect_true(all(c("selected_rows", "table_state") %in% names(result)))
+            expect_false(is.null(result$table_state))
+            expect_equal(result$table_state$selected, c(2, 3))
+            expect_equal(NROW(result$selected_rows), 2)
+            expect_true(all(c("Mazda RX4 Wag", "Datsun 710")
+                            %in% rownames(result$selected_rows)))
+        })
+})

tests/testthat/test_log_viewer.R

@@ -22,7 +22,8 @@ test_that("logViewer - valid sample log", {
     testServer(logViewer,
                args = list(id = "myid", logger = sample_log),
                expr = {
-                   expect_snapshot_output(output$"myid-reactTableOutputID")
+                   expect_true(grepl("Be Sure to Remember to Log ALL user actions", output$"myid-reactTableOutputID", fixed = TRUE))
+                   expect_true(grepl("Resetting in  5 seconds", output$"myid-reactTableOutputID", fixed = TRUE))
                })
 })