Merge branch '503-introduce-shinytest2@main' into session-info@503-introduce-shinytest2@main

Author: vedhav

.github/workflows/check.yaml

@@ -10,11 +10,9 @@ on:
       - ready_for_review
     branches:
       - main
-      - 503-introduce-shinytest2@main
   push:
     branches:
       - main
-      - 503-introduce-shinytest2@main
   workflow_dispatch:
 
 jobs:

DESCRIPTION

@@ -1,8 +1,8 @@
 Type: Package
 Package: teal
 Title: Exploratory Web Apps for Analyzing Clinical Trials Data
-Version: 0.15.2.9003
-Date: 2024-03-12
+Version: 0.15.2.9004
+Date: 2024-03-18
 Authors@R: c(
     person("Dawid", "Kaledkowski", , "dawid.kaledkowski@roche.com", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0001-9533-457X")),

NEWS.md

@@ -1,4 +1,4 @@
-# teal 0.15.2.9003
+# teal 0.15.2.9004
 
 # teal 0.15.2
 

R/TealAppDriver.R

@@ -2,13 +2,12 @@
 
 #' Drive a `teal` application
 #'
-#' This class inherits the `shinytest2::AppDriver` class and has additional
-#' helper functions to help in driving a `teal` application for performing interactions
-#' on a `teal` application for implementing `shinytest2` tests.
+#' Extension of the `shinytest2::AppDriver` class with methods for
+#' driving a teal application for performing interactions for `shinytest2` tests.
 #'
 #' @keywords internal
 #'
-TealAppDriver <- R6::R6Class( # nolint
+TealAppDriver <- R6::R6Class( # nolint: object_name.
   "TealAppDriver",
   inherit = shinytest2::AppDriver,
   # public methods ----
@@ -103,6 +102,7 @@ TealAppDriver <- R6::R6Class( # nolint
     #'
     #' @return The `TealAppDriver` object invisibly.
     navigate_teal_tab = function(tabs) {
+      checkmate::check_character(tabs, min.len = 1)
       for (tab in tabs) {
         root <- "root"
         self$set_input(
@@ -137,53 +137,24 @@ TealAppDriver <- R6::R6Class( # nolint
       private$ns$module
     },
     #' @description
-    #' Get the active shiny name space for interacting with the filter panel.
+    #' Get the active shiny name space bound with a custom `element` name.
     #'
-    #' @return (`string`) The active shiny name space of the component.
-    active_filters_ns = function() {
-      if (identical(private$ns$filter_panel, character(0))) {
-        private$set_active_ns()
-      }
-      private$ns$filter_panel
+    #' @param element `character(1)` custom element name.
+    #'
+    #' @return (`string`) The active shiny name space of the component bound with the input `element`.
+    active_module_element = function(element) {
+      checkmate::assert_string(element)
+      sprintf("#%s-%s", self$active_module_ns(), element)
     },
     #' @description
     #' Get the active shiny name space for interacting with the filter panel.
     #'
     #' @return (`string`) The active shiny name space of the component.
-    filter_manager_ns = function() {
-      if (identical(private$ns$filter_manager, character(0))) {
+    active_filters_ns = function() {
+      if (identical(private$ns$filter_panel, character(0))) {
         private$set_active_ns()
       }
-      private$ns$filter_manager
-    },
-    #' @description
-    #' Advance utility to help in creating namespace and CSS selectors for Shiny UI.
-    #' It is similar with [shiny::NS()] by returning a function that can be used
-    #' to create a namespace for the shiny UI.
-    #'
-    #' This namespace can be enriched with a prefix and suffix to create a CSS selector.
-    #'
-    #' @param namespace (`character(1)`) The base id to be used for the namespace.
-    #' @param ... (`character`) The additional ids to be appended to `namespace`.
-    #'
-    #' @return A function similar to [shiny::NS()] that is used to create a `character`
-    #' namespace for the shiny UI.
-    #'
-    helper_NS = function(namespace, ...) { # nolint: object_name.
-      dots <- rlang::list2(...)
-      checkmate::assert_list(dots, types = "character")
-      base_id <- namespace
-      if (length(dots) > 0) base_id <- paste(c(namespace, dots), collapse = shiny::ns.sep)
-
-      function(..., .css_prefix = "", .css_suffix = "") {
-        dots <- rlang::list2(...)
-        checkmate::assert_list(dots, types = "character")
-        base_string <- sprintf("%s%s%s", .css_prefix, base_id, .css_suffix)
-        if (length(dots) == 0) {
-          return(base_string)
-        }
-        (shiny::NS(base_string))(paste(dots, collapse = shiny::ns.sep))
-      }
+      private$ns$filter_panel
     },
     #' @description
     #' Get the input from the module in the `teal` app.
@@ -193,6 +164,7 @@ TealAppDriver <- R6::R6Class( # nolint
     #'
     #' @return The value of the shiny input.
     get_active_module_input = function(input_id) {
+      checkmate::check_string(input_id)
       self$get_value(input = sprintf("%s-%s", self$active_module_ns(), input_id))
     },
     #' @description
@@ -203,6 +175,7 @@ TealAppDriver <- R6::R6Class( # nolint
     #'
     #' @return The value of the shiny output.
     get_active_module_output = function(output_id) {
+      checkmate::check_string(output_id)
       self$get_value(output = sprintf("%s-%s", self$active_module_ns(), output_id))
     },
     #' @description
@@ -214,6 +187,8 @@ TealAppDriver <- R6::R6Class( # nolint
     #'
     #' @return The `TealAppDriver` object invisibly.
     set_module_input = function(input_id, value) {
+      checkmate::check_string(input_id)
+      checkmate::check_string(value)
       self$set_input(
         sprintf("%s-%s", self$active_module_ns(), input_id),
         value
@@ -223,24 +198,14 @@ TealAppDriver <- R6::R6Class( # nolint
     #' @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 <- vapply(
-        self$get_html(
-          sprintf(
-            "#%s-active-filter_active_vars_contents > span",
-            self$active_filters_ns()
-          )
-        ),
-        function(x) {
-          style <- x %>%
-            rvest::read_html() %>%
-            rvest::html_element("span") %>%
-            rvest::html_attr("style")
-          style <- ifelse(is.na(style), "", style)
-          style != "display: none;"
-        },
-        logical(1),
-        USE.NAMES = FALSE
-      )
+      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()
+        )
+      ) |> unlist()
 
       available_datasets <- self$get_text(
         sprintf(
@@ -256,6 +221,7 @@ TealAppDriver <- R6::R6Class( # nolint
     #' @param dataset_name (character) The name of the dataset to get the filter variables from.
     #' If `NULL`, the filter variables for all the datasets will be returned in a list.
     get_active_data_filters = function(dataset_name = NULL) {
+      checkmate::check_string(dataset_name, null.ok = TRUE)
       datasets <- self$get_active_filter_vars()
       checkmate::assert_subset(dataset_name, datasets)
       active_filters <- lapply(
@@ -286,6 +252,9 @@ TealAppDriver <- R6::R6Class( # nolint
     #'
     #' @return The value of the active filter selection.
     get_active_filter_selection = function(dataset_name, var_name, is_numeric = FALSE) {
+      checkmate::check_string(dataset_name)
+      checkmate::check_string(var_name)
+      checkmate::check_flag(is_numeric)
       selection_suffix <- ifelse(is_numeric, "selection_manual", "selection")
       self$get_value(
         input = sprintf(
@@ -306,6 +275,8 @@ TealAppDriver <- R6::R6Class( # nolint
     #'
     #' @return The `TealAppDriver` object invisibly.
     add_filter_var = function(dataset_name, var_name) {
+      checkmate::check_string(dataset_name)
+      checkmate::check_string(var_name)
       self$set_input(
         sprintf(
           "%s-add-%s-filter-var_to_add",
@@ -326,6 +297,8 @@ TealAppDriver <- R6::R6Class( # nolint
     #'
     #' @return The `TealAppDriver` object invisibly.
     remove_filter_var = function(dataset_name = NULL, var_name = NULL) {
+      checkmate::check_string(dataset_name, null.ok = TRUE)
+      checkmate::check_string(var_name, null.ok = TRUE)
       if (is.null(dataset_name)) {
         remove_selector <- sprintf(
           "#%s-active-remove_all_filters",
@@ -361,6 +334,11 @@ TealAppDriver <- R6::R6Class( # nolint
     #'
     #' @return The `TealAppDriver` object invisibly.
     set_active_filter_selection = function(dataset_name, var_name, input, is_numeric = FALSE) {
+      checkmate::check_string(dataset_name)
+      checkmate::check_string(var_name)
+      checkmate::check_string(input)
+      checkmate::check_flag(is_numeric)
+
       selection_suffix <- ifelse(is_numeric, "selection_manual", "selection")
       self$set_input(
         sprintf(
@@ -376,16 +354,11 @@ TealAppDriver <- R6::R6Class( # nolint
       invisible(self)
     },
     #' @description
-    #' Click on the filter manager show button.
+    #' Wrapper around `get_url()` method that opens the app in the browser.
     #'
-    #' @return The `TealAppDriver` object invisibly.
-    open_filter_manager = function() {
-      active_ns <- self$filter_manager_ns()
-      ns <- self$helper_NS(active_ns)
-
-      self$click(ns("show"))
-      self$wait_for_idle(500)
-      invisible(self)
+    #' @return Nothing. Opens the underlying teal app in the browser.
+    open_url = function() {
+      browseURL(self$get_url())
     }
   ),
   # private members ----
@@ -396,8 +369,7 @@ TealAppDriver <- R6::R6Class( # nolint
     filter = teal_slices(),
     ns = list(
       module = character(0),
-      filter_panel = character(0),
-      filter_manager = character(0)
+      filter_panel = character(0)
     ),
     idle_timeout = 20000, # 20 seconds
     load_timeout = 100000, # 100 seconds
@@ -431,13 +403,6 @@ TealAppDriver <- R6::R6Class( # nolint
       } else {
         private$ns[[component]] <- sprintf("%s-module_%s", active_ns, component)
       }
-
-      component <- "filter_manager"
-      if (!is.null(self$get_html(sprintf("#teal-main_ui-%s-show", component)))) {
-        private$ns[[component]] <- sprintf("teal-main_ui-%s", component)
-      } else {
-        private$ns[[component]] <- sprintf("%s-module_%s", active_ns, component)
-      }
     }
   )
 )

R/init.R

@@ -31,8 +31,8 @@
 #'   The header of the app.
 #' @param footer (`shiny.tag` or `character(1)`)
 #'   The footer of the app.
-#' @param id (`character`)
-#'   Optional string specifying the `shiny` module id in cases it is used as a `shiny` module
+#' @param id (`character`) optional
+#'   string specifying the `shiny` module id in cases it is used as a `shiny` module
 #'   rather than a standalone `shiny` app. This is a legacy feature.
 #'
 #' @return Named list with server and UI functions.

R/modules.R

@@ -395,7 +395,7 @@ is_arg_used <- function(modules, arg) {
 #' Nesting it increases overall depth by 1.
 #'
 #' @inheritParams init
-#' @param depth optional, integer determining current depth level
+#' @param depth optional integer determining current depth level
 #'
 #' @return Depth level for given module.
 #' @keywords internal

R/show_rcode_modal.R

@@ -8,8 +8,8 @@
 #'  Title of the modal, displayed in the first comment of the `R` code.
 #' @param rcode (`character`)
 #'  vector with `R` code to show inside the modal.
-#' @param session (`ShinySession` optional)
-#'  `shiny` session object, if missing then [shiny::getDefaultReactiveDomain()] is used.
+#' @param session (`ShinySession`) optional
+#'  `shiny` session object, defaults to [shiny::getDefaultReactiveDomain()].
 #'
 #' @references [shiny::showModal()]
 #' @export

R/teal_slices.R

@@ -9,7 +9,7 @@
 #'
 #' @inheritParams teal.slice::teal_slices
 #'
-#' @param module_specific optional (`logical(1)`)
+#' @param module_specific (`logical(1)`) optional,
 #'  - `FALSE` (default) when one filter panel applied to all modules.
 #'  All filters will be shared by all modules.
 #'  - `TRUE` when filter panel module-specific.

R/utils.R

@@ -80,7 +80,7 @@ teal_data_to_filtered_data <- function(x, datanames = teal_data_datanames(x)) {
 #'
 #' @param title (`character(1)`) title of the card (unless overwritten by label)
 #' @param label (`character(1)`) label provided by the user when adding the card
-#' @param description (`character(1)`) optional additional description
+#' @param description (`character(1)`) optional, additional description
 #' @param with_filter (`logical(1)`) flag indicating to add filter state
 #' @param filter_panel_api (`FilterPanelAPI`) object with API that allows the generation
 #' of the filter state in the report