Merge branch 'main' into 1032_ellipsis_for_modules_docs@main

.pre-commit-config.yaml

@@ -6,7 +6,7 @@ default_language_version:
   python: python3
 repos:
   - repo: https://github.com/lorenzwalthert/precommit
-    rev: v0.3.2.9027
+    rev: v0.4.0
     hooks:
       - id: style-files
         name: Style code with `styler`

DESCRIPTION

@@ -1,8 +1,8 @@
 Type: Package
 Package: teal
 Title: Exploratory Web Apps for Analyzing Clinical Trials Data
-Version: 0.14.0.9039
-Date: 2024-01-15
+Version: 0.14.0.9041
+Date: 2024-01-25
 Authors@R: c(
     person("Dawid", "Kaledkowski", , "[email protected]", role = c("aut", "cre")),
     person("Pawel", "Rucki", , "[email protected]", role = "aut"),
@@ -76,7 +76,7 @@ Encoding: UTF-8
 Language: en-US
 LazyData: true
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1
 Collate:
     'dummy_functions.R'
     'get_rcode_utils.R'

NEWS.md

@@ -1,4 +1,4 @@
-# teal 0.14.0.9039
+# teal 0.14.0.9041
 
 ### New features
 

R/module_nested_tabs.R

@@ -23,6 +23,7 @@
 #' @param is_module_specific (`logical(1)`)\cr
 #'  flag determining if the filter panel is global or module-specific.
 #'  When set to `TRUE`, a filter panel is called inside of each module tab.
+#'
 #' @return depending on class of `modules`, `ui_nested_tabs` returns:
 #'   - `teal_module`: instantiated UI of the module
 #'   - `teal_modules`: `tabsetPanel` with each tab corresponding to recursively
@@ -267,6 +268,7 @@ srv_nested_tabs.teal_module <- function(id, datasets, modules, is_module_specifi
 #'
 #' @param module (`teal_module`) module where needed filters are taken from
 #' @param datasets (`FilteredData`) object where needed data are taken from
+#'
 #' @return A `teal_data` object.
 #'
 #' @keywords internal
@@ -291,10 +293,14 @@ srv_nested_tabs.teal_module <- function(id, datasets, modules, is_module_specifi
     get_datasets_code(datanames, datasets, hashes)
   )
 
-  do.call(
+
+  data <- do.call(
     teal.data::teal_data,
     args = c(data, code = list(code), join_keys = list(datasets$get_join_keys()[datanames]))
   )
+
+  data@verified <- attr(datasets, "verification_status")
+  return(data)
 }
 
 #' Get the hash of a dataset

R/utils.R

@@ -66,6 +66,7 @@ teal_data_to_filtered_data <- function(x, datanames = teal_data_datanames(x)) {
   )
   # Piggy-back entire pre-processing code so that filtering code can be appended later.
   attr(ans, "preprocessing_code") <- teal.code::get_code(x)
+  attr(ans, "verification_status") <- x@verified
   ans
 }
 

tests/testthat/test-module_nested_tabs.R

@@ -148,29 +148,29 @@ out <- shiny::testServer(
   ),
   expr = {
     testthat::test_that("modules_reactive is a list of reactives", {
-      expect_is(modules_reactive, "list")
-      expect_is(modules_reactive$tab1, "reactive")
-      expect_is(modules_reactive$tab2, "reactive")
+      testthat::expect_is(modules_reactive, "list")
+      testthat::expect_is(modules_reactive$tab1, "reactive")
+      testthat::expect_is(modules_reactive$tab2, "reactive")
     })
 
     testthat::test_that("modules_reactive returns modules according to selection in the nested tabs", {
       session$setInputs(`tab1-active_tab` = "test2") # active tab in tab1
       session$setInputs(`tab2-active_tab` = "test3") # active tab in tab2
       nested_active_modules <- lapply(modules_reactive, function(child) child())
-      expect_identical(nested_active_modules, list(tab1 = test_module2, tab2 = test_module3))
+      testthat::expect_identical(nested_active_modules, list(tab1 = test_module2, tab2 = test_module3))
 
       session$setInputs(`tab1-active_tab` = "test1") # active tab in tab1
       session$setInputs(`tab2-active_tab` = "test4") # active tab in tab2
       nested_active_modules <- lapply(modules_reactive, function(child) child())
-      expect_identical(nested_active_modules, list(tab1 = test_module1, tab2 = test_module4))
+      testthat::expect_identical(nested_active_modules, list(tab1 = test_module1, tab2 = test_module4))
     })
 
     testthat::test_that("Change of this tab returns active module from this tab", {
       session$setInputs(`active_tab` = "tab1")
-      expect_identical(get_active_module(), test_module1)
+      testthat::expect_identical(get_active_module(), test_module1)
 
       session$setInputs(`active_tab` = "tab2")
-      expect_identical(get_active_module(), test_module4)
+      testthat::expect_identical(get_active_module(), test_module4)
     })
   }
 )
@@ -227,7 +227,7 @@ testthat::test_that("srv_nested_tabs.teal_module passes data to the server modul
     moduleServer(id, function(input, output, session) checkmate::assert_list(data, "reactive"))
   })
 
-  testthat::expect_error(
+  testthat::expect_no_error(
     shiny::testServer(
       app = srv_nested_tabs,
       args = list(
@@ -237,8 +237,7 @@ testthat::test_that("srv_nested_tabs.teal_module passes data to the server modul
         reporter = teal.reporter::Reporter$new()
       ),
       expr = NULL
-    ),
-    NA
+    )
   )
 })
 
@@ -249,7 +248,7 @@ testthat::test_that("srv_nested_tabs.teal_module passes (deprecated) datasets to
     })
   )
 
-  testthat::expect_error(
+  testthat::expect_no_error(
     shiny::testServer(
       app = srv_nested_tabs,
       args = list(
@@ -259,8 +258,7 @@ testthat::test_that("srv_nested_tabs.teal_module passes (deprecated) datasets to
         reporter = teal.reporter::Reporter$new()
       ),
       expr = NULL
-    ),
-    NA
+    )
   )
 })
 
@@ -270,7 +268,7 @@ testthat::test_that("srv_nested_tabs.teal_module passes server_args to the ...",
     moduleServer(id, function(input, output, session) stopifnot(identical(list(...), server_args)))
   })
 
-  testthat::expect_error(
+  testthat::expect_no_error(
     shiny::testServer(
       app = srv_nested_tabs,
       args = list(
@@ -280,8 +278,7 @@ testthat::test_that("srv_nested_tabs.teal_module passes server_args to the ...",
         reporter = teal.reporter::Reporter$new()
       ),
       expr = NULL
-    ),
-    NA
+    )
   )
 })
 
@@ -342,7 +339,7 @@ testthat::test_that("srv_nested_tabs.teal_module passes filter_panel_api to the
     moduleServer(id, function(input, output, session) checkmate::assert_class(filter_panel_api, "FilterPanelAPI"))
   })
 
-  testthat::expect_error(
+  testthat::expect_no_error(
     shiny::testServer(
       app = srv_nested_tabs,
       args = list(
@@ -352,8 +349,7 @@ testthat::test_that("srv_nested_tabs.teal_module passes filter_panel_api to the
         reporter = teal.reporter::Reporter$new()
       ),
       expr = NULL
-    ),
-    NA
+    )
   )
 })
 
@@ -426,7 +422,7 @@ testthat::test_that("calculate_hashes takes a FilteredData and vector of datanam
     )
   )
 
-  testthat::expect_error(calculate_hashes(datanames = c("ADSL", "ADAE", "ADTTE"), datasets = datasets), NA)
+  testthat::expect_no_error(calculate_hashes(datanames = c("ADSL", "ADAE", "ADTTE"), datasets = datasets))
 })
 
 testthat::test_that("calculate_hashes returns a named list", {

tests/testthat/test-report_previewer_module.R

@@ -1,14 +1,18 @@
 testthat::test_that("report_previewer_module throws error if label is not string", {
-  expect_error(reporter_previewer_module(label = 5), "Assertion on 'label' failed: Must be of type 'string'")
-  expect_error(reporter_previewer_module(label = c("A", "B")), "Assertion on 'label' failed: Must have length 1.")
+  testthat::expect_error(
+    reporter_previewer_module(label = 5), "Assertion on 'label' failed: Must be of type 'string'"
+  )
+  testthat::expect_error(
+    reporter_previewer_module(label = c("A", "B")), "Assertion on 'label' failed: Must have length 1."
+  )
 })
 
 testthat::test_that("report_previewer_module throws no error and stores label if label is string", {
-  expect_error(r_p_m <- reporter_previewer_module(label = "My label"), NA)
-  expect_equal(r_p_m$label, "My label")
+  testthat::expect_no_error(r_p_m <- reporter_previewer_module(label = "My label"))
+  testthat::expect_equal(r_p_m$label, "My label")
 })
 
 testthat::test_that("report_previewer_module default label is Report previewer ", {
   r_p_m <- reporter_previewer_module()
-  expect_equal(r_p_m$label, "Report previewer")
+  testthat::expect_equal(r_p_m$label, "Report previewer")
 })

tests/testthat/test-tdata.R

@@ -4,16 +4,15 @@ withr::local_options(lifecycle_verbosity = "quiet")
 testthat::test_that("new_tdata accepts reactive and not reactive MAE and data.frames", {
   utils::data(miniACC, package = "MultiAssayExperiment")
 
-  testthat::expect_error(
+  testthat::expect_no_error(
     new_tdata(
       list(
         a = reactive(data.frame(x = 1:10)),
         b = data.frame(y = 1:10),
         c = reactive(miniACC),
         d = miniACC
       )
-    ),
-    NA
+    )
   )
 })
 
@@ -50,12 +49,12 @@ testthat::test_that("new_tdata throws error if code is not character or reactive
 })
 
 testthat::test_that("new_tdata accepts character and reactive characters for code argument", {
-  testthat::expect_error(
-    new_tdata(list(x = iris, y = mtcars), code = c("x <- iris", "y <- mtcars")), NA
+  testthat::expect_no_error(
+    new_tdata(list(x = iris, y = mtcars), code = c("x <- iris", "y <- mtcars"))
   )
 
-  testthat::expect_error(
-    new_tdata(list(x = iris, y = mtcars), code = reactive(c("x <- iris", "y <- mtcars"))), NA
+  testthat::expect_no_error(
+    new_tdata(list(x = iris, y = mtcars), code = reactive(c("x <- iris", "y <- mtcars")))
   )
 })
 
@@ -67,9 +66,8 @@ testthat::test_that("new_tdata throws error if join_keys is not of class join_ke
 })
 
 testthat::test_that("new_tdata throws no error if join_keys is of class join_keys", {
-  testthat::expect_error(
-    new_tdata(list(x = iris), join_keys = teal.data::join_keys()),
-    NA
+  testthat::expect_no_error(
+    new_tdata(list(x = iris), join_keys = teal.data::join_keys())
   )
 })
 
@@ -96,9 +94,8 @@ testthat::test_that(
 )
 
 testthat::test_that("new_tdata does not throw error with valid metadata", {
-  testthat::expect_error(
-    new_tdata(list(x = iris, y = mtcars), metadata = list(x = list(A = 1), y = list(B = 1))),
-    NA
+  testthat::expect_no_error(
+    new_tdata(list(x = iris, y = mtcars), metadata = list(x = list(A = 1), y = list(B = 1)))
   )
 })
 
@@ -160,7 +157,7 @@ testthat::test_that("get_code returns character of code if tdata object has code
 
 testthat::test_that("get_code_tdata accepts tdata", {
   data <- new_tdata(data = list(iris = iris), code = "iris <- iris")
-  testthat::expect_error(isolate(get_code_tdata(data)), NA)
+  testthat::expect_no_error(isolate(get_code_tdata(data)))
 })
 
 testthat::test_that("get_code_tdata throws error when input is not tdata", {

tests/testthat/test-teal_reporter.R

@@ -1,5 +1,5 @@
 testthat::test_that("TealReportCard object can be initialized", {
-  testthat::expect_error(TealReportCard$new(), regexp = NA)
+  testthat::expect_no_error(TealReportCard$new())
 })
 
 testthat::test_that("TealReportCard inherits from ReportCard", {
@@ -24,7 +24,7 @@ testthat::test_that("TealReportCard$get_content returns content with metadata",
 
 testthat::test_that("TealReportCard$append_src accepts a character", {
   card <- TealReportCard$new()
-  testthat::expect_error(card$append_src("test"), regexp = NA)
+  testthat::expect_no_error(card$append_src("test"))
 })
 
 testthat::test_that("TealReportCard$append_src returns self", {
@@ -40,7 +40,7 @@ testthat::test_that("TealReportCard$append_src returns title and content", {
 
 testthat::test_that("TealReportCard$append_encodings accepts list of character", {
   card <- TealReportCard$new()
-  testthat::expect_error(card$append_encodings(list(a = "test")), NA)
+  testthat::expect_no_error(card$append_encodings(list(a = "test")))
 })
 
 testthat::test_that("TealReportCard$append_encodings returns self", {
@@ -60,11 +60,10 @@ testthat::test_that("TealReportCard$append_fs accepts only a teal_slices", {
   testthat::expect_error(card$append_fs(c(a = 1, b = 2)),
     regexp = "Assertion on 'fs' failed: Must inherit from class 'teal_slices', but has class 'numeric'."
   )
-  testthat::expect_error(
+  testthat::expect_no_error(
     card$append_fs(
       teal.slice::teal_slices(teal.slice::teal_slice(dataname = "a", varname = "b"))
-    ),
-    regexp = NA
+    )
   )
 })
 
@@ -84,7 +83,7 @@ testthat::test_that("TealReportCard$append_fs returns title and content", {
 })
 
 testthat::test_that("TealSlicesBlock$new accepts teal_slices only", {
-  testthat::expect_error(TealSlicesBlock$new(teal_slices()), NA)
+  testthat::expect_no_error(TealSlicesBlock$new(teal_slices()))
   testthat::expect_error(TealSlicesBlock$new(list()), "Assertion on 'content'")
 })
 

tests/testthat/test-utils.R

@@ -87,16 +87,16 @@ test_that("validate_app_title_tag works on validating the title tag", {
     tags$div("Secret")
   )
 
-  expect_silent(validate_app_title_tag(valid_title))
-  expect_error(validate_app_title_tag(head_missing))
-  expect_error(validate_app_title_tag(title_missing))
-  expect_error(validate_app_title_tag(icon_missing))
-  expect_error(validate_app_title_tag(invalid_link))
+  testthat::expect_silent(validate_app_title_tag(valid_title))
+  testthat::expect_error(validate_app_title_tag(head_missing))
+  testthat::expect_error(validate_app_title_tag(title_missing))
+  testthat::expect_error(validate_app_title_tag(icon_missing))
+  testthat::expect_error(validate_app_title_tag(invalid_link))
 })
 
 test_that("build_app_title builts a valid tag", {
   valid_title_local <- build_app_title("title", "logo.png")
   valid_title_remote <- build_app_title("title", "https://raw.githubusercontent.com/insightsengineering/hex-stickers/main/PNG/nest.png") # nolint
-  expect_silent(validate_app_title_tag(valid_title_local))
-  expect_silent(validate_app_title_tag(valid_title_remote))
+  testthat::expect_silent(validate_app_title_tag(valid_title_local))
+  testthat::expect_silent(validate_app_title_tag(valid_title_remote))
 })