Improves datanames error message

R/init.R

@@ -225,7 +225,7 @@ init <- function(data,
 
     is_modules_ok <- check_modules_datanames(modules, teal_data_datanames(data))
     if (!isTRUE(is_modules_ok)) {
-      logger::log_warn(is_modules_ok)
+      lapply(is_modules_ok$string, logger::log_warn)
     }
 
     is_filter_ok <- check_filter_datanames(filter, teal_data_datanames(data))

R/module_teal_data.R

@@ -151,7 +151,6 @@ srv_validate_reactive_teal_data <- function(id, # nolint: object_length
         )
       )
 
-
       data_out
     })
 
@@ -164,7 +163,13 @@ srv_validate_reactive_teal_data <- function(id, # nolint: object_length
       if (inherits(data_out_rv(), "teal_data")) {
         is_modules_ok <- check_modules_datanames(modules = modules, datanames = teal_data_ls(data_validated()))
         if (!isTRUE(is_modules_ok)) {
-          tags$div(is_modules_ok, class = "teal-output-warning")
+          tags$div(
+            is_modules_ok$html(
+              # Show modules prefix on message only in teal_data_module tab
+              grepl(sprintf("data-teal_data_module-%s", id), session$ns(NULL), fixed = TRUE)
+            ),
+            class = "teal-output-warning"
+          )
         }
       }
     })

R/utils.R

@@ -123,22 +123,48 @@ check_modules_datanames <- function(modules, datanames) {
   recursive_check_datanames <- function(modules, datanames) {
     # check teal_modules against datanames
     if (inherits(modules, "teal_modules")) {
-      sapply(modules$children, function(module) recursive_check_datanames(module, datanames = datanames))
+      result <- lapply(modules$children, function(module) recursive_check_datanames(module, datanames = datanames))
+      result <- result[vapply(result, Negate(is.null), logical(1L))]
+      list(
+        string = do.call(c, as.list(unname(sapply(result, function(x) x$string)))),
+        html = function(with_module_name = TRUE) {
+          tagList(
+            lapply(
+              result,
+              function(x) x$html(with_module_name = with_module_name)
+            )
+          )
+        }
+      )
     } else {
       extra_datanames <- setdiff(modules$datanames, c("all", datanames))
       if (length(extra_datanames)) {
-        sprintf(
-          "Module '%s' uses datanames not available in 'data': (%s) not in (%s)",
-          modules$label,
-          toString(dQuote(extra_datanames, q = FALSE)),
-          toString(dQuote(datanames, q = FALSE))
+        list(
+          string = build_datanames_error_message(
+            modules$label,
+            datanames,
+            extra_datanames,
+            tags = list(span = paste, code = function(x) toString(dQuote(x, q = FALSE))),
+            paste0
+          ),
+          # Build HTML representation of the error message with <pre> formatting
+          html = function(with_module_name = TRUE) {
+            tagList(
+              build_datanames_error_message(
+                if (with_module_name) modules$label,
+                datanames,
+                extra_datanames
+              ),
+              tags$br(.noWS = "before")
+            )
+          }
         )
       }
     }
   }
-  check_datanames <- unlist(recursive_check_datanames(modules, datanames))
+  check_datanames <- recursive_check_datanames(modules, datanames)
   if (length(check_datanames)) {
-    paste(check_datanames, collapse = "\n")
+    check_datanames
   } else {
     TRUE
   }
@@ -321,3 +347,49 @@ strip_style <- function(string) {
     useBytes = TRUE
   )
 }
+
+#' Convert character list to human readable html with commas and "and"
+#' @noRd
+paste_datanames_character <- function(x,
+                                      tags = list(span = shiny::tags$span, code = shiny::tags$code),
+                                      tagList = shiny::tagList) {
+  checkmate::assert_character(x)
+  do.call(
+    tagList,
+    lapply(seq_along(x), function(.ix) {
+      tagList(
+        tags$code(x[.ix]),
+        if (.ix != length(x)) {
+          tags$span(ifelse(.ix == length(x) - 1, " and ", ", "))
+        }
+      )
+    })
+  )
+}
+
+#' Build datanames error string for error message
+#'
+#' tags and tagList are overwritten in arguments allowing to create strings for
+#' logging purposes
+#' @noRd
+build_datanames_error_message <- function(label = NULL,
+                                          datanames,
+                                          extra_datanames,
+                                          tags = list(span = shiny::tags$span, code = shiny::tags$code),
+                                          tagList = shiny::tagList) {
+  tags$span(
+    tags$span("Dataset"),
+    paste_datanames_character(extra_datanames, tags, tagList),
+    tags$span(ifelse(length(extra_datanames) > 1, "are missing", "is missing")),
+    tags$span("in the available data"),
+    tags$span(
+      paste(
+        ifelse(is.null(label), ",", sprintf("for '%s',", label))
+      ),
+      .noWS = c("after-begin", "before-end")
+    ),
+    tags$span(ifelse(length(datanames) > 1, "which has:", "which have:")),
+    tags$span(paste_datanames_character(datanames, tags, tagList)),
+    tags$span(".", .noWS = "before")
+  )
+}

inst/css/validation.css

@@ -37,7 +37,7 @@
 .teal_primary_col .teal_validated:has(.shiny-output-error),
 .teal_primary_col .teal_validated:has(.teal-output-warning) {
   margin: 1em 0 1em 0;
-  padding: .5em 0 .5em 0;
+  padding: .5em 0 .5em .5em;
 }
 
 .teal_primary_col > .teal_validated:has(.teal-output-warning),