Merge branch 'main' into 898_save_app_state3@main

DESCRIPTION

@@ -1,8 +1,8 @@
 Type: Package
 Package: teal
 Title: Exploratory Web Apps for Analyzing Clinical Trials Data
-Version: 0.15.2.9010
-Date: 2024-03-20
+Version: 0.15.2.9015
+Date: 2024-03-21
 Authors@R: c(
     person("Dawid", "Kaledkowski", , "[email protected]", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0001-9533-457X")),
@@ -50,7 +50,7 @@ Imports:
     shinyjs,
     stats,
     teal.code (>= 0.5.0),
-    teal.logger (>= 0.1.1),
+    teal.logger (>= 0.1.3.9013),
     teal.reporter (>= 0.2.0),
     teal.widgets (>= 0.4.0),
     utils

NEWS.md

@@ -1,4 +1,4 @@
-# teal 0.15.2.9010
+# teal 0.15.2.9015
 
 ### New features
 * Introduced bookmarking feature. Click the bookmark icon in the top-right corner to access the bookmark manager.

R/TealAppDriver.R

@@ -208,14 +208,16 @@ TealAppDriver <- R6::R6Class( # nolint: object_name.
     #' @description
     #' Get the active datasets that can be accessed via the filter panel of the current active teal module.
     get_active_filter_vars = function() {
-      displayed_datasets_index <- self$get_js(
-        sprintf(
-          "Array.from(
-              document.querySelectorAll(\"#%s-active-filter_active_vars_contents > span\")
-          ).map((el) => window.getComputedStyle(el).display != \"none\");",
-          self$active_filters_ns()
+      displayed_datasets_index <- unlist(
+        self$get_js(
+          sprintf(
+            "Array.from(
+                document.querySelectorAll(\"#%s-active-filter_active_vars_contents > span\")
+            ).map((el) => window.getComputedStyle(el).display != \"none\");",
+            self$active_filters_ns()
+          )
         )
-      ) |> unlist()
+      )
 
       available_datasets <- self$get_text(
         sprintf(
@@ -237,49 +239,25 @@ TealAppDriver <- R6::R6Class( # nolint: object_name.
       active_filters <- lapply(
         datasets,
         function(x) {
-          self$get_text(
+          var_names <- self$get_text(
             sprintf(
               "#%s-active-%s-filters .filter-card-varname",
               self$active_filters_ns(),
               x
             )
-          ) |>
+          ) %>%
             gsub(pattern = "\\s", replacement = "")
+          structure(
+            lapply(var_names, private$get_active_filter_selection, dataset_name = x),
+            names = var_names
+          )
         }
       )
       names(active_filters) <- datasets
-      if (!is.null(dataset_name)) {
-        active_filters <- active_filters[[dataset_name]]
-      }
-      active_filters
-    },
-    #' @description
-    #' Get the active filter values from the active filter selection of dataset from the filter panel.
-    #'
-    #' @param dataset_name (character) The name of the dataset to get the filter values from.
-    #' @param var_name (character) The name of the variable to get the filter values from.
-    #'
-    #' @return The value of the active filter selection.
-    get_active_filter_selection = function(dataset_name, var_name) {
-      checkmate::check_string(dataset_name)
-      checkmate::check_string(var_name)
-      input_id_prefix <- sprintf(
-        "%s-active-%s-filter-%s_%s-inputs",
-        self$active_filters_ns(),
-        dataset_name,
-        dataset_name,
-        var_name
-      )
-
-      # Find the type of filter (categorical or range)
-      supported_suffix <- c("selection", "selection_manual")
-      for (suffix in supported_suffix) {
-        if (!is.null(self$get_html(sprintf("#%s-%s", input_id_prefix, suffix)))) {
-          return(self$get_value(input = sprintf("%s-%s", input_id_prefix, suffix)))
-        }
+      if (is.null(dataset_name)) {
+        return(active_filters)
       }
-
-      NULL # If there are not any supported filters
+      active_filters[[dataset_name]]
     },
     #' @description
     #' Add a new variable from the dataset to be filtered.
@@ -404,6 +382,18 @@ TealAppDriver <- R6::R6Class( # nolint: object_name.
       invisible(self)
     },
     #' @description
+    #' Extract `html` attribute (found by a `selector`).
+    #'
+    #' @param selector (`character(1)`) specifying the selector to be used to get the content of a specific node.
+    #' @param attribute (`character(1)`) name of an attribute to retrieve from a node specified by `selector`.
+    #'
+    #' @return The `character` vector.
+    get_attr = function(selector, attribute) {
+      self$get_html_rvest("html") %>%
+        rvest::html_nodes(selector) %>%
+        rvest::html_attr(attribute)
+    },
+    #' @description
     #' Wrapper around `get_html` that passes the output directly to `rvest::read_html`.
     #'
     #' @param selector `(character(1))` passed to `get_html`.
@@ -461,6 +451,34 @@ TealAppDriver <- R6::R6Class( # nolint: object_name.
       } else {
         private$ns[[component]] <- sprintf("%s-module_%s", active_ns, component)
       }
+    },
+    # @description
+    # Get the active filter values from the active filter selection of dataset from the filter panel.
+    #
+    # @param dataset_name (character) The name of the dataset to get the filter values from.
+    # @param var_name (character) The name of the variable to get the filter values from.
+    #
+    # @return The value of the active filter selection.
+    get_active_filter_selection = function(dataset_name, var_name) {
+      checkmate::check_string(dataset_name)
+      checkmate::check_string(var_name)
+      input_id_prefix <- sprintf(
+        "%s-active-%s-filter-%s_%s-inputs",
+        self$active_filters_ns(),
+        dataset_name,
+        dataset_name,
+        var_name
+      )
+
+      # Find the type of filter (categorical or range)
+      supported_suffix <- c("selection", "selection_manual")
+      for (suffix in supported_suffix) {
+        if (!is.null(self$get_html(sprintf("#%s-%s", input_id_prefix, suffix)))) {
+          return(self$get_value(input = sprintf("%s-%s", input_id_prefix, suffix)))
+        }
+      }
+
+      NULL # If there are not any supported filters
     }
   )
 )

R/landing_popup_module.R

@@ -66,7 +66,7 @@ landing_popup_module <- function(label = "Landing Popup",
   )
   checkmate::assert_multi_class(buttons, classes = c("shiny.tag", "shiny.tag.list"))
 
-  logger::log_info("Initializing landing_popup_module")
+  message("Initializing landing_popup_module")
 
   module <- module(
     label = label,

R/modules.R

@@ -206,7 +206,6 @@ module <- function(label = "module",
     datanames <- filters
     msg <-
       "The `filters` argument is deprecated and will be removed in the next release. Please use `datanames` instead."
-    logger::log_warn(msg)
     warning(msg)
   }
 

R/reporter_previewer_module.R

@@ -24,7 +24,7 @@ reporter_previewer_module <- function(label = "Report previewer", server_args =
   checkmate::assert_list(server_args, names = "named")
   checkmate::assert_true(all(names(server_args) %in% names(formals(teal.reporter::reporter_previewer_srv))))
 
-  logger::log_info("Initializing reporter_previewer_module")
+  message("Initializing reporter_previewer_module")
 
   srv <- function(id, reporter, ...) {
     teal.reporter::reporter_previewer_srv(id, reporter, ...)

R/zzz.R

@@ -10,6 +10,8 @@
 
   # Set up the teal logger instance
   teal.logger::register_logger("teal")
+  teal.logger::register_handlers("teal")
+
   # Turn on server-side bookmarking in shiny.
   shiny::shinyOptions("bookmarkStore" = "server")
 

tests/testthat/setup-logger.R

@@ -1 +1 @@
-logger::log_appender(function(...) {}, namespace = "teal")
+logger::log_appender(function(...) NULL, namespace = "teal")

tests/testthat/setup-testing_depth.R

@@ -0,0 +1,49 @@
+#' Returns testing depth set by session option or by environmental variable.
+#'
+#' @details Looks for the session option `TESTING_DEPTH` first.
+#' If not set, takes the system environmental variable `TESTING_DEPTH`.
+#' If neither is set, then returns 3 by default.
+#' If the value of `TESTING_DEPTH` is not a numeric of length 1, then returns 3.
+#'
+#' @return `numeric(1)` the testing depth.
+#'
+get_testing_depth <- function() {
+  default_depth <- 3
+  depth <- getOption("TESTING_DEPTH", Sys.getenv("TESTING_DEPTH", default_depth))
+  depth <- tryCatch(
+    as.numeric(depth),
+    error = function(error) default_depth,
+    warning = function(warning) default_depth
+  )
+  if (length(depth) != 1) depth <- default_depth
+  depth
+}
+
+#' Skipping tests in the testthat pipeline under specific scope
+#' @description This function should be used per each `testthat::test_that` call.
+#'   Each of the call should specify an appropriate depth value.
+#'   The depth value will set the appropriate scope so more/less time consuming tests could be recognized.
+#'   The environment variable `TESTING_DEPTH` is used for changing the scope of `testthat` pipeline.
+#' `TESTING_DEPTH` interpretation for each possible value:
+#' \itemize{
+#' \item{0}{no tests at all}
+#' \item{1}{fast - small scope - executed on every commit}
+#' \item{3}{medium - medium scope - daily integration pipeline}
+#' \item{5}{slow - all tests - daily package tests}
+#' }
+#' @param depth `numeric` the depth of the testing evaluation,
+#'   has opposite interpretation to environment variable `TESTING_DEPTH`.
+#'   So e.g. `0` means run it always and `5` means a heavy test which should be run rarely.
+#'   If the `depth` argument is larger than `TESTING_DEPTH` then the test is skipped.
+#' @importFrom testthat skip
+#' @return `NULL` or invoke an error produced by `testthat::skip`
+#' @note By default `TESTING_DEPTH` is equal to 3 if there is no environment variable for it.
+#' By default `depth` argument lower or equal to 3 will not be skipped because by default `TESTING_DEPTH`
+#' is equal to 3. To skip <= 3 depth tests then the environment variable has to be lower than 3 respectively.
+skip_if_too_deep <- function(depth) { # nolintr
+  checkmate::assert_numeric(depth, len = 1, lower = 0, upper = 5)
+  testing_depth <- get_testing_depth() # by default 3 if there are no env variable
+  if (testing_depth < depth) {
+    testthat::skip(paste("testing depth", testing_depth, "is below current testing specification", depth))
+  }
+}

tests/testthat/test-shinytest2-filter_panel.R

@@ -1,4 +1,5 @@
 testthat::test_that("e2e: module content is updated when a data is filtered in filter panel", {
+  skip_if_too_deep(5)
   app <- TealAppDriver$new(
     data = simple_teal_data(),
     modules = modules(
@@ -27,6 +28,7 @@ testthat::test_that("e2e: module content is updated when a data is filtered in f
 })
 
 testthat::test_that("e2e: filtering a module-specific filter is refected in other shared module", {
+  skip_if_too_deep(5)
   app <- TealAppDriver$new(
     data = simple_teal_data(),
     modules = modules(
@@ -69,6 +71,7 @@ testthat::test_that("e2e: filtering a module-specific filter is refected in othe
 })
 
 testthat::test_that("e2e: filtering a module-specific filter is not refected in other unshared modules", {
+  skip_if_too_deep(5)
   app <- TealAppDriver$new(
     data = simple_teal_data(),
     modules = modules(

tests/testthat/test-shinytest2-init.R

@@ -1,4 +1,5 @@
 testthat::test_that("e2e: teal app initializes with no errors", {
+  skip_if_too_deep(5)
   app <- TealAppDriver$new(
     data = simple_teal_data(),
     modules = example_module(label = "Example Module")
@@ -9,6 +10,7 @@ testthat::test_that("e2e: teal app initializes with no errors", {
 })
 
 testthat::test_that("e2e: teal app initializes with sessionInfo modal", {
+  skip_if_too_deep(5)
   app <- TealAppDriver$new(
     data = simple_teal_data(),
     modules = example_module(label = "Example Module")
@@ -65,6 +67,7 @@ testthat::test_that("e2e: teal app initializes with sessionInfo modal", {
 })
 
 testthat::test_that("e2e: init creates UI containing specified title, favicon, header and footer", {
+  skip_if_too_deep(5)
   app_title <- "Custom Teal App Title"
   app_favicon <- "https://raw.githubusercontent.com/insightsengineering/hex-stickers/main/PNG/teal.png"
   app_header <- "Custom Teal App Header"