diff --git a/.pre-commit-config.yaml b/.pre-commit-config.yaml index 8d29e346a8..48f8f6e02a 100644 --- a/.pre-commit-config.yaml +++ b/.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` diff --git a/DESCRIPTION b/DESCRIPTION index 99ae8637a6..ad4a88d025 100644 --- a/DESCRIPTION +++ b/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", , "dawid.kaledkowski@roche.com", role = c("aut", "cre")), person("Pawel", "Rucki", , "pawel.rucki@roche.com", 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' diff --git a/NEWS.md b/NEWS.md index b5dc5a8f20..fa67604361 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# teal 0.14.0.9039 +# teal 0.14.0.9041 ### New features diff --git a/R/module_nested_tabs.R b/R/module_nested_tabs.R index 73afb01be8..dc84f86c75 100644 --- a/R/module_nested_tabs.R +++ b/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 diff --git a/R/utils.R b/R/utils.R index 99ba006535..63434747c7 100644 --- a/R/utils.R +++ b/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 } diff --git a/tests/testthat/test-module_nested_tabs.R b/tests/testthat/test-module_nested_tabs.R index 3009423127..3f07fc6a87 100644 --- a/tests/testthat/test-module_nested_tabs.R +++ b/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", { diff --git a/tests/testthat/test-report_previewer_module.R b/tests/testthat/test-report_previewer_module.R index d5d7b900ec..5636bed5cb 100644 --- a/tests/testthat/test-report_previewer_module.R +++ b/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") }) diff --git a/tests/testthat/test-tdata.R b/tests/testthat/test-tdata.R index a34c871426..daf6979b19 100644 --- a/tests/testthat/test-tdata.R +++ b/tests/testthat/test-tdata.R @@ -4,7 +4,7 @@ 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)), @@ -12,8 +12,7 @@ testthat::test_that("new_tdata accepts reactive and not reactive MAE and data.fr 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", { diff --git a/tests/testthat/test-teal_reporter.R b/tests/testthat/test-teal_reporter.R index 79401b4d15..7df055dac0 100644 --- a/tests/testthat/test-teal_reporter.R +++ b/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'") }) diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index 8f45f896b0..77561d3ce9 100644 --- a/tests/testthat/test-utils.R +++ b/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)) })