Merge branch 'test' into 257261_default_col_palette

Author: gm-ebs-ext

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: dv.papo
 Title: Patient Profile
-Version: 2.0.5-900
+Version: 2.0.6-900
 Date: 2024-08-13
 Authors@R: 
     c(person("Boehringer-Ingelheim Pharma GmbH & Co.KG", role = c("cph", "fnd")),

NEWS.md

@@ -1,3 +1,6 @@
+# dv.papo 2.0.6-900
+- Update to provide early error feedback if a sender_id is not available in list of modules.
+
 # dv.papo 2.0.5-900
 - Fixes missing palette colours for AE, CM grading values.
 

R/check_papo_call_manual.R

@@ -4,7 +4,7 @@
 # This function has been written manually, but mod_patient_profile_API carries
 # enough information to derive most of it automatically
 check_papo_call <- function(datasets, module_id, subject_level_dataset_name, subjid_var,
-                            sender_ids, summary, listings, plots) {
+                            sender_ids, summary, listings, plots, afmm_module_names) {
   warn <- character(0)
   err <- character(0)
 
@@ -91,6 +91,18 @@ check_papo_call <- function(datasets, module_id, subject_level_dataset_name, sub
   }
 
   # TODO: sender_ids
+  if (!missing(sender_ids) && !is.null(sender_ids)) {
+    unknown_sender_ids <- setdiff(sender_ids, names(afmm_module_names))
+    assert_err(
+      length(unknown_sender_ids) < 1,
+      sprintf(
+        "The `sender_ids` - %s - are not available. The modules available are - %s.
+        Please check spelling of `sender_ids` in case there's a typo!",
+        paste0("'", unknown_sender_ids, "'", collapse = ", "),
+        paste0("'", names(afmm_module_names), "'", collapse = ", ")
+      )
+    )
+  }
 
   # summary
   if (!missing(summary) && !is.null(summary)) {

R/mod_patient_profile.R

@@ -338,7 +338,7 @@ mod_patient_profile <- function(module_id = "",
         # Overwrite first "argument" (the function call, in fact) with the datasets provided to module manager
         names(args)[[1]] <- "datasets"
         args[[1]] <- afmm[["unfiltered_dataset"]]()
-
+        args[["afmm_module_names"]] <- afmm[["module_names"]]
         do.call(check_papo_call, args)
       })
 
@@ -374,12 +374,18 @@ mod_patient_profile <- function(module_id = "",
         return(datasets[plot_dataset_names])
       })
 
+      # filter missing sender_ids so app error doesn't conflict with early error feedback.
+      known_sender_ids <- sender_ids
+      if (!is.null(sender_ids)) {
+        known_sender_ids <- intersect(sender_ids, names(afmm[["module_names"]]))
+      }
+
       dv.papo::mod_patient_profile_server(
         id = module_id,
         subject_level_dataset = subject_level_dataset,
         extra_datasets = extra_datasets,
         subjid_var = subjid_var,
-        sender_ids = lapply(sender_ids, function(x) {
+        sender_ids = lapply(known_sender_ids, function(x) {
           shiny::reactive(afmm[["module_output"]]()[[x]])
         }),
         summary = summary,

tests/testthat/apps/misconfigured_app/app.R

@@ -4,6 +4,10 @@ dataset_list <- list(
 
 dv.manager::run_app(
   data = dataset_list,
-  module_list = list("Papo" = dv.papo::mod_patient_profile(module_id = "papo")),
+  module_list = list(
+    "Papo" = dv.papo::mod_patient_profile(
+      module_id = "papo", sender_ids = "random1"
+    )
+  ),
   filter_data = "adsl"
 )

tests/testthat/test-all.R

@@ -89,6 +89,8 @@ test_that(
     validation_errors <- app$get_html(selector = "#papo-validator-ui")
     expect_true(grepl("`subject_level_dataset_name` missing", validation_errors, fixed = TRUE))
     expect_true(grepl("`subjid_var` missing", validation_errors, fixed = TRUE))
+    expect_true(grepl("The `sender_ids` - 'random1' - are not available.",
+                      validation_errors, fixed = TRUE))
 
     app$stop()
   }