Tweak API checking and minor doc fixes.

Author: ml-ebs-ext

R/CM.R

@@ -1,5 +1,7 @@
-# YT#VHb3a67af97b323ee47762788154a489fd#VHa53bd254d6ac8e6a19dfa057febb06b5#
+# YT#VHd079be9470139acf1264d75176dd9b2c#VHe9395a780f86f7653c9f11cadba1e3f0#
 CM <- local({ # _C_hecked _M_odule
+  # 2025-07-11: [feature] New `manual_check` flag to tell `CM$generate_check_functions()` to ignore particular elements
+  # 2025-04-09: [fix] Make `generate_map_afmm_function` maps multi-variable parameters (e.g. `visit_vars`)
   # 2025-03-21: [feature] report errors for all loaded datasets and [fix] dehardcode "PARAM" string and use `par` argument
 
   message_well <- function(title, contents, color = "f5f5f5") {
@@ -281,6 +283,13 @@ CM <- local({ # _C_hecked _M_odule
       elem <- spec$elements[[elem_name]]
       attrs_ids <- setdiff(names(attributes(elem)), c("names", "docs"))
       attrs <- attributes(elem)[attrs_ids]
+      
+      if(isTRUE(attrs[["manual_check"]])) {
+        push(sprintf("'NOTE: %s (%s) tagged as \"manual_check\"'\n", elem_name, elem$kind))
+        push(sprintf("'      The expectation is that it either does not require automated checks or that'\n"))
+        push(sprintf("'      the caller of this function has written manual checks near the call site.'\n"))
+        next
+      }
 
       if (isTRUE(attrs[["subjid_var"]])) {
         subjid_vars <- c(subjid_vars, elem_name)
@@ -320,6 +329,11 @@ CM <- local({ # _C_hecked _M_odule
           "OK[['%s']] <- CM$check_function('%s', %s, %d, flags, warn, err)\n",
           elem_name, elem_name, elem_name, elem$arg_count
         ))
+      } else if (elem$kind == "group") {
+        push(sprintf("'NOTE: %s (%s) unsupported as the check generator cannot handle nested elements yet'\n",
+                     elem_name, elem$kind))
+        push(sprintf("'      The expectation is that it either does not require automated checks or that'\n"))
+        push(sprintf("'      the caller of this function has written manual checks near the call site.'\n"))
       } else {
         push(sprintf("'NOTE: %s (%s) has no associated automated checks'\n", elem_name, elem$kind))
         push(sprintf("'      The expectation is that it either does not require them or that'\n"))
@@ -422,11 +436,24 @@ CM <- local({ # _C_hecked _M_odule
         elem <- spec$elements[[elem_name]]
         stopifnot(elem$kind == "col")
         dataset_name <- elem[["dataset_name"]]
-        push(sprintf("if(is.character(ds[[%s]][[%s]])){\n", dataset_name, elem_name))
-        push("mapping_summary <- c(mapping_summary,")
-        push(sprintf("paste0('(', ds_name, ') ', %s, '[[\"', %s, '\"]]')", dataset_name, elem_name))
-        push(")\n")
-        push("}\n")
+        
+        multiple <- (isTRUE(attr(elem, "zero_or_more")) || isTRUE(attr(elem, "one_or_more")))
+        if (multiple) {
+          push(sprintf("for (.elem in %s) {\n", elem_name))
+          push(sprintf("if(is.character(ds[[%s]][[.elem]])){\n", dataset_name))
+          push("mapping_summary <- c(mapping_summary,")
+          push(sprintf("paste0('(', ds_name, ') ', %s, '[[\"', .elem, '\"]]')", dataset_name))
+          push(")\n")
+          push("}\n")
+          push("}\n")
+        } else {
+          push(sprintf("if(is.character(ds[[%s]][[%s]])){\n", dataset_name, elem_name))
+          push("mapping_summary <- c(mapping_summary,")
+          push(sprintf("paste0('(', ds_name, ') ', %s, '[[\"', %s, '\"]]')", dataset_name, elem_name))
+          push(")\n")
+          push("}\n")
+        }
+        
       }
       push("}\n")
 
@@ -449,10 +476,20 @@ CM <- local({ # _C_hecked _M_odule
         elem <- spec$elements[[elem_name]]
         dataset_name <- elem[["dataset_name"]]
 
-        push(sprintf("if (is.character(res[[%s]][[%s]])) {\n", dataset_name, elem_name))
-        push(sprintf("  res[[%s]][[%s]] <- ", dataset_name, elem_name))
-        push(sprintf("    as.factor(res[[%s]][[%s]])\n", dataset_name, elem_name))
-        push("}\n")
+        multiple <- (isTRUE(attr(elem, "zero_or_more")) || isTRUE(attr(elem, "one_or_more")))
+        if (multiple) {
+          push(sprintf("for (.elem in %s) {\n", elem_name))
+          push(sprintf("if (is.character(res[[%s]][[.elem]])) {\n", dataset_name))
+          push(sprintf("  res[[%s]][[.elem]] <- ", dataset_name))
+          push(sprintf("    as.factor(res[[%s]][[.elem]])\n", dataset_name))
+          push("}\n")
+          push("}\n")
+        } else {
+          push(sprintf("if (is.character(res[[%s]][[%s]])) {\n", dataset_name, elem_name))
+          push(sprintf("  res[[%s]][[%s]] <- ", dataset_name, elem_name))
+          push(sprintf("    as.factor(res[[%s]][[%s]])\n", dataset_name, elem_name))
+          push("}\n")
+        }
       }
 
       push("  return(res)\n")

R/TC.R

@@ -1,4 +1,4 @@
-# YT#VH1202cc468f3cbf448dd25ff917fc4762#VH00000000000000000000000000000000#
+# YT#VHf29a3f572c107632b46daf31f56ecd34#VH1202cc468f3cbf448dd25ff917fc4762#
 TC <- local({ # _T_ype C_hecks
   # basic types
   T_logical <- function() list(kind = "logical")
@@ -78,6 +78,7 @@ TC <- local({ # _T_ype C_hecks
         "named",                      # elements of targetted argument must be named
         "map_character_to_factor",    # the target TC$col() will be transformed to factor prior to reaching the module
         "ignore",                     # argument should be ignored by Dressing Room, for now
+        "manual_check",               # CM$generate_check_functions will not generate an automated check for this element
         # domain-specific flags
         "subject_level_dataset_name", # indicates dataset with one row per subject
         "subjid_var"                  # indicates unique subject identifier column on dataset pointed at by subject_level_dataset_name 

R/check_call_auto.R

@@ -11,23 +11,23 @@ check_mod_listings_auto <- function(afmm, datasets, module_id, dataset_names, de
     flags <- list(one_or_more = TRUE)
     OK[["dataset_names"]] <- CM$check_dataset_name("dataset_names", dataset_names, flags, datasets, used_dataset_names,
         warn, err)
-    "NOTE: default_vars (group) has no associated automated checks"
-    "      The expectation is that it either does not require them or that"
+    "NOTE: default_vars (group) tagged as \"manual_check\""
+    "      The expectation is that it either does not require automated checks or that"
     "      the caller of this function has written manual checks near the call site."
-    "NOTE: pagination (group) has no associated automated checks"
-    "      The expectation is that it either does not require them or that"
+    "NOTE: pagination (logical) tagged as \"manual_check\""
+    "      The expectation is that it either does not require automated checks or that"
     "      the caller of this function has written manual checks near the call site."
-    "NOTE: intended_use_label (group) has no associated automated checks"
-    "      The expectation is that it either does not require them or that"
+    "NOTE: intended_use_label (character) tagged as \"manual_check\""
+    "      The expectation is that it either does not require automated checks or that"
     "      the caller of this function has written manual checks near the call site."
-    "NOTE: subjid_var (group) has no associated automated checks"
-    "      The expectation is that it either does not require them or that"
+    "NOTE: subjid_var (character) tagged as \"manual_check\""
+    "      The expectation is that it either does not require automated checks or that"
     "      the caller of this function has written manual checks near the call site."
-    "NOTE: review (group) has no associated automated checks"
-    "      The expectation is that it either does not require them or that"
+    "NOTE: review (group) tagged as \"manual_check\""
+    "      The expectation is that it either does not require automated checks or that"
     "      the caller of this function has written manual checks near the call site."
-    "NOTE: receiver_id (group) has no associated automated checks"
-    "      The expectation is that it either does not require them or that"
+    "NOTE: receiver_id (character) tagged as \"manual_check\""
+    "      The expectation is that it either does not require automated checks or that"
     "      the caller of this function has written manual checks near the call site."
     return(OK)
 }

R/mod_listings.R

@@ -205,7 +205,7 @@ listings_UI <- function(module_id) { # nolint
 #' @param intended_use_label `[character(1) | NULL]` Either a string indicating the intended use for export, or
 #' NULL. The provided label will be displayed prior to the download and will also be included in the exported file.
 #'
-#' @param subjid_var `[character(1) | NULL]`
+#' @param subjid_var `[character(1)]`
 #'
 #' Column corresponding to subject ID. Default value is 'USUBJID'
 #'
@@ -760,19 +760,31 @@ mod_listings_API_docs <- list(
   pagination = list(""),
   intended_use_label = list(""),
   subjid_var = list(""), 
-  review = list(""), 
+  review = list(
+    "Review-related fields",
+    datasets = list(""),
+    choices = list(""),
+    roles = list(""),
+    store_path = list("")
+  ), 
   receiver_id = list("")
 )
 
 mod_listings_API_spec <- TC$group(
   module_id = TC$mod_ID(),
   dataset_names = TC$dataset_name() |> TC$flag("one_or_more"),
-  default_vars = TC$group() |> TC$flag("ignore"),         # manually tested by check_mod_listings
-  pagination = TC$group() |> TC$flag("ignore"),           # manually tested by check_mod_listings
-  intended_use_label = TC$group() |> TC$flag("ignore"),   # manually tested by check_mod_listings
-  subjid_var = TC$group() |> TC$flag("ignore"),           # manually tested by check_mod_listings
-  review = TC$group() |> TC$flag("ignore"),               # functionality is a WIP, so not defining for now
-  receiver_id = TC$group() |> TC$flag("ignore")           # manually tested by check_mod_listings
+  default_vars = TC$group() |> TC$flag("manual_check"),                         # manually tested by check_mod_listings
+  pagination = TC$logical() |> TC$flag("manual_check", "optional"),             # manually tested by check_mod_listings
+  intended_use_label = TC$character() |> TC$flag("manual_check", "optional"),   # manually tested by check_mod_listings
+  subjid_var = TC$character() |> TC$flag("manual_check"),                       # manually tested by check_mod_listings
+  review = TC$group(
+    # TODO: functionality is a WIP, so not defining for now
+    datasets = TC$group(),
+    choices = TC$character() |> TC$flag("one_or_more"),
+    roles = TC$character() |> TC$flag("one_or_more"),
+    store_path = TC$character() |> TC$flag("optional")
+  ) |> TC$flag("manual_check", "optional"),
+  receiver_id = TC$character() |> TC$flag("manual_check")                       # manually tested by check_mod_listings
 ) |> TC$attach_docs(mod_listings_API_docs)
 
 dataset_info_listings <- function(dataset_names, ...) {