769 replace filters argument

NEWS.md

@@ -10,6 +10,7 @@
 ### Breaking changes
 
 * Specifying `filter` argument in `teal::init` requires `teal_slices` object now. Details in documentation of `teal::init`.
+* Soft deprecated `filters` argument in `module` and replaced it with `datanames`. Details in documentation of `teal::module`
 
 ### Miscellaneous
 

R/dummy_functions.R

@@ -93,7 +93,7 @@ example_datasets <- function() { # nolint
 #'   shinyApp(app$ui, app$server)
 #' }
 #' @export
-example_module <- function(label = "example teal module", filters = "all") {
+example_module <- function(label = "example teal module", datanames = "all") {
   checkmate::assert_string(label)
   module(
     label,
@@ -110,7 +110,7 @@ example_module <- function(label = "example teal module", filters = "all") {
         encoding = selectInput(ns("dataname"), "Choose a dataset", choices = names(data))
       )
     },
-    filters = filters
+    datanames = datanames
   )
 }
 
@@ -130,13 +130,13 @@ example_modules <- function(datanames = c("ADSL", "ADTTE")) {
       label = "d2",
       modules(
         label = "d3",
-        example_module(label = "aaa1", filters = datanames),
-        example_module(label = "aaa2", filters = datanames),
-        example_module(label = "aaa3", filters = datanames)
+        example_module(label = "aaa1", datanames = datanames),
+        example_module(label = "aaa2", datanames = datanames),
+        example_module(label = "aaa3", datanames = datanames)
       ),
-      example_module(label = "bbb", filters = datanames)
+      example_module(label = "bbb", datanames = datanames)
     ),
-    example_module(label = "ccc", filters = datanames)
+    example_module(label = "ccc", datanames = datanames)
   )
   return(mods)
 }

R/init.R

@@ -70,7 +70,7 @@
 #'       label = "data source",
 #'       server = function(input, output, session, data) {},
 #'       ui = function(id, ...) div(p("information about data source")),
-#'       filters = "all"
+#'       datanames = "all"
 #'     ),
 #'     example_module(label = "example teal module"),
 #'     module(
@@ -84,7 +84,7 @@
 #'         ns <- NS(id)
 #'         plotOutput(ns("hist"))
 #'       },
-#'       filters = "new_iris"
+#'       datanames = "new_iris"
 #'     )
 #'   ),
 #'   title = "App title",
@@ -144,10 +144,10 @@ init <- function(data,
       modules$children <- sapply(modules$children, resolve_modules_datanames, simplify = FALSE)
       modules
     } else {
-      modules$filters <- if (identical(modules$filters, "all")) {
+      modules$datanames <- if (identical(modules$datanames, "all")) {
         datanames
-      } else if (is.character(modules$filters)) {
-        datanames_adjusted <- intersect(modules$filters, datanames)
+      } else if (is.character(modules$datanames)) {
+        datanames_adjusted <- intersect(modules$datanames, datanames)
         include_parent_datanames(dataname = datanames_adjusted, join_keys = join_keys)
       }
       modules

R/module_nested_tabs.R

@@ -61,7 +61,8 @@ NULL
 
 #' @rdname module_nested_tabs
 ui_nested_tabs <- function(id, modules, datasets, depth = 0L, is_module_specific = FALSE) {
-  checkmate::assert_int(depth)
+  checkmate::assert_multi_class(modules, c("teal_modules", "teal_module"))
+  checkmate::assert_count(depth)
   UseMethod("ui_nested_tabs", modules)
 }
 
@@ -133,7 +134,7 @@ ui_nested_tabs.teal_module <- function(id, modules, datasets, depth = 0L, is_mod
     )
   )
 
-  if (!is.null(modules$filter) && is_module_specific) {
+  if (!is.null(modules$datanames) && is_module_specific) {
     fluidRow(
       column(width = 9, teal_ui, class = "teal_primary_col"),
       column(
@@ -150,6 +151,7 @@ ui_nested_tabs.teal_module <- function(id, modules, datasets, depth = 0L, is_mod
 #' @rdname module_nested_tabs
 srv_nested_tabs <- function(id, datasets, modules, is_module_specific = FALSE,
                             reporter = teal.reporter::Reporter$new()) {
+  checkmate::assert_multi_class(modules, c("teal_modules", "teal_module"))
   checkmate::assert_class(reporter, "Reporter")
   UseMethod("srv_nested_tabs", modules)
 }
@@ -166,6 +168,7 @@ srv_nested_tabs.default <- function(id, datasets, modules, is_module_specific =
 srv_nested_tabs.teal_modules <- function(id, datasets, modules, is_module_specific = FALSE,
                                          reporter = teal.reporter::Reporter$new()) {
   checkmate::assert_list(datasets, types = c("list", "FilteredData"))
+
   moduleServer(id = id, module = function(input, output, session) {
     logger::log_trace("srv_nested_tabs.teal_modules initializing the module { deparse1(modules$label) }.")
 
@@ -180,7 +183,8 @@ srv_nested_tabs.teal_modules <- function(id, datasets, modules, is_module_specif
           is_module_specific = is_module_specific,
           reporter = reporter
         )
-      }
+      },
+      simplify = FALSE
     )
 
     # when not ready input$active_tab would return NULL - this would fail next reactive
@@ -203,12 +207,13 @@ srv_nested_tabs.teal_modules <- function(id, datasets, modules, is_module_specif
 #' @export
 srv_nested_tabs.teal_module <- function(id, datasets, modules, is_module_specific = TRUE,
                                         reporter = teal.reporter::Reporter$new()) {
-  checkmate::assert_class(datasets, class = "FilteredData")
+  checkmate::assert_class(datasets, "FilteredData")
   logger::log_trace("srv_nested_tabs.teal_module initializing the module: { deparse1(modules$label) }.")
+
   moduleServer(id = id, module = function(input, output, session) {
     modules$server_args <- teal.transform::resolve_delayed(modules$server_args, datasets)
-    if (!is.null(modules$filter) && is_module_specific) {
-      datasets$srv_filter_panel("module_filter_panel", active_datanames = reactive(modules$filter))
+    if (!is.null(modules$datanames) && is_module_specific) {
+      datasets$srv_filter_panel("module_filter_panel", active_datanames = reactive(modules$datanames))
     }
 
     # Create two triggers to limit reactivity between filter-panel and modules.
@@ -288,14 +293,17 @@ srv_nested_tabs.teal_module <- function(id, datasets, modules, is_module_specifi
 #'
 #' @keywords internal
 .datasets_to_data <- function(module, datasets, trigger_data = reactiveVal(1L)) {
+  checkmate::assert_class(module, "teal_module")
+  checkmate::assert_class(datasets, "FilteredData")
   checkmate::assert_class(trigger_data, "reactiveVal")
-  datanames <- if (is.null(module$filter)) datasets$datanames() else module$filter
+
+  datanames <- if (is.null(module$datanames)) datasets$datanames() else module$datanames
 
   # list of reactive filtered data
   data <- sapply(
-    USE.NAMES = TRUE,
-    X = datanames,
-    FUN = function(x) eventReactive(trigger_data(), datasets$get_data(x, filtered = TRUE))
+    datanames,
+    function(x) eventReactive(trigger_data(), datasets$get_data(x, filtered = TRUE)),
+    simplify = FALSE
   )
 
   hashes <- calculate_hashes(datanames, datasets)
@@ -327,11 +335,5 @@ srv_nested_tabs.teal_module <- function(id, datasets, modules, is_module_specifi
 #' @keywords internal
 #'
 calculate_hashes <- function(datanames, datasets) {
-  sapply(
-    datanames,
-    simplify = FALSE,
-    function(x) {
-      rlang::hash(datasets$get_data(x, filtered = FALSE))
-    }
-  )
+  sapply(datanames, function(x) rlang::hash(datasets$get_data(x, filtered = FALSE)), simplify = FALSE)
 }

R/module_snapshot_manager.R

@@ -152,13 +152,13 @@ snapshot_manager_srv <- function(id, slices_global, mapping_matrix, filtered_dat
       snapshot_state <- as.teal_slices(snapshot)
       mapping_unfolded <- unfold_mapping(attr(snapshot_state, "mapping"), names(filtered_data_list))
       mapply(
-        function(filtered_data, filters) {
+        function(filtered_data, filter_ids) {
           filtered_data$clear_filter_states(force = TRUE)
-          slices <- Filter(function(x) x$id %in% filters, snapshot_state)
+          slices <- Filter(function(x) x$id %in% filter_ids, snapshot_state)
           filtered_data$set_filter_state(slices)
         },
         filtered_data = filtered_data_list,
-        filters = mapping_unfolded
+        filter_ids = mapping_unfolded
       )
       slices_global(snapshot_state)
       removeModal()
@@ -186,13 +186,13 @@ snapshot_manager_srv <- function(id, slices_global, mapping_matrix, filtered_dat
             snapshot_state <- as.teal_slices(snapshot)
             mapping_unfolded <- unfold_mapping(attr(snapshot_state, "mapping"), names(filtered_data_list))
             mapply(
-              function(filtered_data, filters) {
+              function(filtered_data, filter_ids) {
                 filtered_data$clear_filter_states(force = TRUE)
-                slices <- Filter(function(x) x$id %in% filters, snapshot_state)
+                slices <- Filter(function(x) x$id %in% filter_ids, snapshot_state)
                 filtered_data$set_filter_state(slices)
               },
               filtered_data = filtered_data_list,
-              filters = mapping_unfolded
+              filter_ids = mapping_unfolded
             )
             slices_global(snapshot_state)
             removeModal()

R/module_tabs_with_filters.R

@@ -122,7 +122,7 @@ srv_tabs_with_filters <- function(id,
     )
 
     if (!is_module_specific) {
-      active_datanames <- reactive(active_module()$filters)
+      active_datanames <- reactive(active_module()$datanames)
       singleton <- unlist(datasets)[[1]]
       singleton$srv_filter_panel("filter_panel", active_datanames = active_datanames)
 

R/module_teal.R

@@ -182,20 +182,20 @@ srv_teal <- function(id, modules, raw_data, filter = teal_slices()) {
           names(datasets) <- labels
           datasets
         } else if (isTRUE(attr(filter, "module_specific"))) {
-          # we should create FilteredData even if modules$filter is null
+          # we should create FilteredData even if modules$datanames is null
           # null controls a display of filter panel but data should be still passed
-          datanames <- if (is.null(modules$filter)) raw_data()$get_datanames() else modules$filter
+          datanames <- if (is.null(modules$datanames)) raw_data()$get_datanames() else modules$datanames
           data_objects <- sapply(
             datanames,
-            simplify = FALSE,
-            FUN = function(dataname) {
+            function(dataname) {
               dataset <- raw_data()$get_dataset(dataname)
               list(
                 dataset = dataset$get_raw_data(),
                 metadata = dataset$get_metadata(),
                 label = dataset$get_dataset_label()
               )
-            }
+            },
+            simplify = FALSE
           )
           datasets_module <- teal.slice::init_filtered_data(
             data_objects,

R/modules.R

@@ -41,7 +41,7 @@
 #'           ns <- NS(id)
 #'           tagList(dataTableOutput(ns("data")))
 #'         },
-#'         filters = "all"
+#'         datanames = "all"
 #'       )
 #'     ),
 #'     module(
@@ -58,7 +58,7 @@
 #'         ns <- NS(id)
 #'         tagList(textOutput(ns("text")))
 #'       },
-#'       filters = NULL
+#'       datanames = NULL
 #'     )
 #'   )
 #' )
@@ -145,10 +145,11 @@ is_arg_used <- function(modules, arg) {
 #'  - `data` (optional)  module will receive list of reactive (filtered) data specified in the `filters` argument.
 #'  - `datasets` (optional)  module will receive `FilteredData`. (See `[teal.slice::FilteredData]`).
 #'  - `...` (optional) `ui_args` elements will be passed to the module named argument or to the `...`.
-#' @param filters (`character`) A vector with `datanames` that are relevant for the item. The
+#' @param filters (`character`) Deprecated. Use `datanames` instead.
+#' @param datanames (`character`) A vector with `datanames` that are relevant for the item. The
 #'   filter panel will automatically update the shown filters to include only
 #'   filters in the listed datasets. `NULL` will hide the filter panel,
-#'   and the keyword `'all'` will show the filters of all datasets. `filters` determines also
+#'   and the keyword `'all'` will show filters of all datasets. `datanames` also determines
 #'   a subset of datasets which are appended to the `data` argument in `server` function.
 #' @param server_args (named `list`) with additional arguments passed on to the
 #'   `server` function.
@@ -190,16 +191,26 @@ module <- function(label = "module",
                    ui = function(id, ...) {
                      tags$p(paste0("This module has no UI (id: ", id, " )"))
                    },
-                   filters = "all",
+                   filters,
+                   datanames = "all",
                    server_args = NULL,
                    ui_args = NULL) {
   checkmate::assert_string(label)
   checkmate::assert_function(server)
   checkmate::assert_function(ui)
-  checkmate::assert_character(filters, min.len = 1, null.ok = TRUE, any.missing = FALSE)
+  checkmate::assert_character(datanames, min.len = 1, null.ok = TRUE, any.missing = FALSE)
   checkmate::assert_list(server_args, null.ok = TRUE, names = "named")
   checkmate::assert_list(ui_args, null.ok = TRUE, names = "named")
 
+  if (!missing(filters)) {
+    checkmate::assert_character(filters, min.len = 1, null.ok = TRUE, any.missing = FALSE)
+    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)
+  }
+
   if (label == "global_filters") {
     stop("Label 'global_filters' is reserved in teal. Please change to something else.")
   }
@@ -221,6 +232,11 @@ module <- function(label = "module",
     )
   }
 
+  if (!is.element("data", server_formals)) {
+    message(sprintf("module \"%s\" server function takes no data so \"datanames\" will be ignored", label))
+    datanames <- NULL
+  }
+
   srv_extra_args <- setdiff(names(server_args), server_formals)
   if (length(srv_extra_args) > 0 && !"..." %in% server_formals) {
     stop(
@@ -254,7 +270,7 @@ module <- function(label = "module",
   structure(
     list(
       label = label,
-      server = server, ui = ui, filters = filters,
+      server = server, ui = ui, datanames = datanames,
       server_args = server_args, ui_args = ui_args
     ),
     class = "teal_module"

R/modules_debugging.R

@@ -40,6 +40,6 @@ filter_calls_module <- function(label = "Filter Calls Module") { # nolint
         verbatimTextOutput(ns("filter_calls"))
       )
     },
-    filters = "all"
+    datanames = "all"
   )
 }

R/reporter_previewer_module.R

@@ -30,7 +30,7 @@ reporter_previewer_module <- function(label = "Report previewer", server_args =
   module <- module(
     label = label,
     server = srv, ui = ui,
-    server_args = server_args, ui_args = list(), filters = NULL
+    server_args = server_args, ui_args = list(), datanames = NULL
   )
   class(module) <- c("teal_module_previewer", class(module))
   module

R/validations.R

@@ -284,16 +284,14 @@ validate_no_intersection <- function(x, y, msg) {
 #' }
 validate_has_variable <- function(data, varname, msg) {
   if (length(varname) != 0) {
-    has_vars <- all(varname %in% names(data))
-    has_all <- all(has_vars)
+    has_vars <- varname %in% names(data)
 
-    if (!has_all) {
+    if (!all(has_vars)) {
       if (missing(msg)) {
-        dataname <- deparse(substitute(data))
-        msg <- paste(
-          dataname, "does not have the required variables:",
-          paste(varname[!has_vars], collapse = ", "),
-          "."
+        msg <- sprintf(
+          "%s does not have the required variables: %s.",
+          deparse(substitute(data)),
+          toString(varname[!has_vars])
         )
       }
       validate(need(FALSE, msg))