From b022241e728b41da61fffa282bf9d121546c996b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Dawid=20Ka=C5=82=C4=99dkowski?=
 <dawid.kaledkowski@gmail.com>
Date: Tue, 29 Oct 2024 14:31:39 +0100
Subject: [PATCH] The documentation of `check_modules_datanames()` (#1395)

Closes #1321
Little refurnishment:
- splitted `check_modules_datanames` to two functions, one to return
`character` and other to return `shiny.tag.list`
- Renamed related utilities to better fit to what they do.
---
 R/init.R                          |   2 +-
 R/module_teal.R                   |   1 +
 R/module_teal_data.R              |  12 +-
 R/utils.R                         | 198 ++++++++++++++----------------
 man/check_modules_datanames.Rd    |  14 ++-
 tests/testthat/test-init.R        |  15 ++-
 tests/testthat/test-module_teal.R | 131 ++++++++++++++++----
 7 files changed, 227 insertions(+), 146 deletions(-)

diff --git a/R/init.R b/R/init.R
index a62034eaf8..005bc448f9 100644
--- a/R/init.R
+++ b/R/init.R
@@ -213,7 +213,7 @@ init <- function(data,
 
     is_modules_ok <- check_modules_datanames(modules, ls(teal.code::get_env(data)))
     if (!isTRUE(is_modules_ok) && length(unlist(extract_transformers(modules))) == 0) {
-      lapply(is_modules_ok$string, warning, call. = FALSE)
+      warning(is_modules_ok, call. = FALSE)
     }
 
     is_filter_ok <- check_filter_datanames(filter, ls(teal.code::get_env(data)))
diff --git a/R/module_teal.R b/R/module_teal.R
index 8624636dd2..3e913c2340 100644
--- a/R/module_teal.R
+++ b/R/module_teal.R
@@ -210,6 +210,7 @@ srv_teal <- function(id, data, modules, filter = teal_slices()) {
     data_load_status <- reactive({
       if (inherits(data_pulled(), "teal_data")) {
         "ok"
+        # todo: should we hide warnings on top for a data?
       } else if (inherits(data, "teal_data_module")) {
         "teal_data_module failed"
       } else {
diff --git a/R/module_teal_data.R b/R/module_teal_data.R
index 899ef14028..ebf95b115f 100644
--- a/R/module_teal_data.R
+++ b/R/module_teal_data.R
@@ -222,15 +222,11 @@ srv_check_shiny_warnings <- function(id, data, modules) {
   moduleServer(id, function(input, output, session) {
     output$message <- renderUI({
       if (inherits(data(), "teal_data")) {
-        is_modules_ok <- check_modules_datanames(modules = modules, datanames = ls(teal.code::get_env(data())))
+        is_modules_ok <- check_modules_datanames_html(
+          modules = modules, datanames = ls(teal.code::get_env(data()))
+        )
         if (!isTRUE(is_modules_ok)) {
-          tags$div(
-            class = "teal-output-warning",
-            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)
-            )
-          )
+          tags$div(is_modules_ok, class = "teal-output-warning")
         }
       }
     })
diff --git a/R/utils.R b/R/utils.R
index e5830bf0ca..0397774e7b 100644
--- a/R/utils.R
+++ b/R/utils.R
@@ -122,76 +122,112 @@ report_card_template <- function(title, label, description = NULL, with_filter,
 
 #' Check `datanames` in modules
 #'
-#' This function ensures specified `datanames` in modules match those in the data object,
-#' returning error messages or `TRUE` for successful validation.
+#' These functions check if specified `datanames` in modules match those in the data object,
+#' returning error messages or `TRUE` for successful validation. Two functions return error message
+#' in different forms:
+#' - `check_modules_datanames` returns `character(1)` for basic assertion usage
+#' - `check_modules_datanames_html` returns `shiny.tag.list` to display it in the app.
 #'
 #' @param modules (`teal_modules`) object
 #' @param datanames (`character`) names of datasets available in the `data` object
 #'
-#' @return A `character(1)` containing error message or `TRUE` if validation passes.
+#' @return `TRUE` if validation passes, otherwise `character(1)` or `shiny.tag.list`
 #' @keywords internal
 check_modules_datanames <- function(modules, datanames) {
-  checkmate::assert_multi_class(modules, c("teal_modules", "teal_module"))
-  checkmate::assert_character(datanames)
+  out <- check_modules_datanames_html(modules, datanames)
+  if (inherits(out, "shiny.tag.list")) {
+    out_with_ticks <- gsub("<code>|</code>", "`", toString(out))
+    out_text <- gsub("<[^<>]+>", "", toString(out_with_ticks))
+    trimws(gsub("[[:space:]]+", " ", out_text))
+  } else {
+    out
+  }
+}
 
-  recursive_check_datanames <- function(modules, datanames) {
-    # check teal_modules against datanames
-    if (inherits(modules, "teal_modules")) {
-      result <- lapply(modules$children, function(module) recursive_check_datanames(module, datanames = datanames))
-      result <- result[vapply(result, Negate(is.null), logical(1L))]
-      if (length(result) == 0) {
-        return(NULL)
-      }
-      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)
+#' @rdname check_modules_datanames
+check_modules_datanames_html <- function(modules,
+                                         datanames) {
+  check_datanames <- check_modules_datanames_recursive(modules, datanames)
+  show_module_info <- inherits(modules, "teal_modules") # used in two contexts - module and app
+  if (!length(check_datanames)) {
+    return(TRUE)
+  }
+  shiny::tagList(
+    lapply(
+      check_datanames,
+      function(mod) {
+        tagList(
+          tags$span(
+            tags$span(if (length(mod$missing_datanames) == 1) "Dataset" else "Datasets"),
+            to_html_code_list(mod$missing_datanames),
+            tags$span(
+              paste0(
+                if (length(mod$missing_datanames) > 1) "are missing" else "is missing",
+                if (show_module_info) sprintf(" for module '%s'.", mod$label) else "."
+              )
             )
-          )
-        }
-      )
-    } else {
-      extra_datanames <- setdiff(modules$datanames, c("all", datanames))
-      if (length(extra_datanames)) {
-        list(
-          string = build_datanames_error_message(
-            modules$label,
-            datanames,
-            extra_datanames,
-            tags = list(
-              span = function(..., .noWS = NULL) { # nolint: object_name
-                trimws(paste(..., sep = ifelse(is.null(.noWS), " ", ""), collapse = " "))
-              },
-              code = function(x) toString(dQuote(x, q = FALSE))
-            ),
-            tagList = function(...) trimws(paste(...))
           ),
-          # Build HTML representation of the error message with <pre> formatting
-          html = function(with_module_name = TRUE) {
+          if (length(datanames) >= 1) {
             tagList(
-              build_datanames_error_message(
-                if (with_module_name) modules$label,
-                datanames,
-                extra_datanames
-              ),
-              tags$br(.noWS = "before")
+              tags$span(if (length(datanames) == 1) "Dataset" else "Datasets"),
+              tags$span("available in data:"),
+              tagList(
+                tags$span(
+                  to_html_code_list(datanames),
+                  tags$span(".", .noWS = "outside"),
+                  .noWS = c("outside")
+                )
+              )
             )
-          }
+          } else {
+            tags$span("No datasets are available in data.")
+          },
+          tags$br(.noWS = "before")
         )
       }
-    }
-  }
-  check_datanames <- recursive_check_datanames(modules, datanames)
-  if (length(check_datanames)) {
-    check_datanames
+    )
+  )
+}
+
+#' Recursively checks modules and returns list for every datanames mismatch between module and data
+#' @noRd
+check_modules_datanames_recursive <- function(modules, datanames) { # nolint: object_name_length
+  checkmate::assert_multi_class(modules, c("teal_module", "teal_modules"))
+  checkmate::assert_character(datanames)
+  if (inherits(modules, "teal_modules")) {
+    unlist(
+      lapply(modules$children, check_modules_datanames_recursive, datanames = datanames),
+      recursive = FALSE
+    )
   } else {
-    TRUE
+    missing_datanames <- setdiff(modules$datanames, c("all", datanames))
+    if (length(missing_datanames)) {
+      list(list(
+        label = modules$label,
+        missing_datanames = missing_datanames
+      ))
+    }
   }
 }
 
+#' Convert character vector to html code separated with commas and "and"
+#' @noRd
+to_html_code_list <- function(x) {
+  checkmate::assert_character(x)
+  do.call(
+    tagList,
+    lapply(seq_along(x), function(.ix) {
+      tagList(
+        tags$code(x[.ix]),
+        if (.ix != length(x)) {
+          if (.ix == length(x) - 1) tags$span(" and ") else tags$span(", ", .noWS = "before")
+        }
+      )
+    })
+  )
+}
+
+
 #' Check `datanames` in filters
 #'
 #' This function checks whether `datanames` in filters correspond to those in `data`,
@@ -340,59 +376,3 @@ 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) { # nolint: object_name.
-  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) { # nolint: object_name.
-  tags$span(
-    tags$span(ifelse(length(extra_datanames) > 1, "Datasets", "Dataset")),
-    paste_datanames_character(extra_datanames, tags, tagList),
-    tags$span(
-      paste0(
-        ifelse(length(extra_datanames) > 1, "are missing", "is missing"),
-        ifelse(is.null(label), ".", sprintf(" for tab '%s'.", label))
-      )
-    ),
-    if (length(datanames) >= 1) {
-      tagList(
-        tags$span(ifelse(length(datanames) > 1, "Datasets", "Dataset")),
-        tags$span("available in data:"),
-        tagList(
-          tags$span(
-            paste_datanames_character(datanames, tags, tagList),
-            tags$span(".", .noWS = "outside"),
-            .noWS = c("outside")
-          )
-        )
-      )
-    } else {
-      tags$span("No datasets are available in data.")
-    }
-  )
-}
diff --git a/man/check_modules_datanames.Rd b/man/check_modules_datanames.Rd
index 7fef35aec0..b01270eae2 100644
--- a/man/check_modules_datanames.Rd
+++ b/man/check_modules_datanames.Rd
@@ -2,9 +2,12 @@
 % Please edit documentation in R/utils.R
 \name{check_modules_datanames}
 \alias{check_modules_datanames}
+\alias{check_modules_datanames_html}
 \title{Check \code{datanames} in modules}
 \usage{
 check_modules_datanames(modules, datanames)
+
+check_modules_datanames_html(modules, datanames)
 }
 \arguments{
 \item{modules}{(\code{teal_modules}) object}
@@ -12,10 +15,15 @@ check_modules_datanames(modules, datanames)
 \item{datanames}{(\code{character}) names of datasets available in the \code{data} object}
 }
 \value{
-A \code{character(1)} containing error message or \code{TRUE} if validation passes.
+\code{TRUE} if validation passes, otherwise \code{character(1)} or \code{shiny.tag.list}
 }
 \description{
-This function ensures specified \code{datanames} in modules match those in the data object,
-returning error messages or \code{TRUE} for successful validation.
+These functions check if specified \code{datanames} in modules match those in the data object,
+returning error messages or \code{TRUE} for successful validation. Two functions return error message
+in different forms:
+\itemize{
+\item \code{check_modules_datanames} returns \code{character(1)} for basic assertion usage
+\item \code{check_modules_datanames_html} returns \code{shiny.tag.list} to display it in the app.
+}
 }
 \keyword{internal}
diff --git a/tests/testthat/test-init.R b/tests/testthat/test-init.R
index d0a022330c..1ebca65fa2 100644
--- a/tests/testthat/test-init.R
+++ b/tests/testthat/test-init.R
@@ -64,7 +64,20 @@ testthat::test_that(
         data = teal.data::teal_data(mtcars = mtcars),
         modules = list(example_module(datanames = "iris"))
       ),
-      "Dataset \"iris\" is missing for tab 'example teal module'. Dataset available in data: \"mtcars\"."
+      "Dataset `iris` is missing for module 'example teal module'. Dataset available in data: `mtcars`."
+    )
+  }
+)
+
+testthat::test_that(
+  "init throws warning when datanames in modules incompatible w/ datanames in data and there is no transformers",
+  {
+    testthat::expect_warning(
+      init(
+        data = teal.data::teal_data(mtcars = mtcars),
+        modules = list(example_module(datanames = c("a", "b")))
+      ),
+      "Datasets `a` and `b` are missing for module 'example teal module'. Dataset available in data: `mtcars`."
     )
   }
 )
diff --git a/tests/testthat/test-module_teal.R b/tests/testthat/test-module_teal.R
index ed01caaef4..2fa450ed60 100644
--- a/tests/testthat/test-module_teal.R
+++ b/tests/testthat/test-module_teal.R
@@ -551,32 +551,115 @@ testthat::describe("srv_teal teal_modules", {
     )
   })
 
-  testthat::it("throws warning when dataname is not available", {
-    testthat::skip_if_not_installed("rvest")
-    shiny::testServer(
-      app = srv_teal,
-      args = list(
-        id = "test",
-        data = teal_data(mtcars = mtcars),
-        modules = modules(
-          module("module_1", server = function(id, data) data, datanames = c("iris"))
-        )
-      ),
-      expr = {
-        session$setInputs(`teal_modules-active_tab` = "module_1")
+  testthat::describe("warnings on missing datanames", {
+    testthat::it("warns when dataname is not available", {
+      testthat::skip_if_not_installed("rvest")
+      shiny::testServer(
+        app = srv_teal,
+        args = list(
+          id = "test",
+          data = teal_data(iris = iris),
+          modules = modules(
+            module("module_1", server = function(id, data) data, datanames = c("iris", "missing"))
+          )
+        ),
+        expr = {
+          session$setInputs(`teal_modules-active_tab` = "module_1")
+          testthat::expect_equal(
+            trimws(
+              rvest::html_text2(
+                rvest::read_html(
+                  output[["teal_modules-module_1-validate_datanames-shiny_warnings-message"]]$html
+                )
+              )
+            ),
+            "Dataset missing is missing. Dataset available in data: iris."
+          )
+        }
+      )
+    })
 
-        testthat::expect_equal(
-          trimws(
-            rvest::html_text2(
-              rvest::read_html(
-                output[["teal_modules-module_1-validate_datanames-shiny_warnings-message"]]$html
+    testthat::it("warns when datanames are not available", {
+      testthat::skip_if_not_installed("rvest")
+      shiny::testServer(
+        app = srv_teal,
+        args = list(
+          id = "test",
+          data = teal_data(mtcars = mtcars, iris = iris),
+          modules = modules(
+            module("module_1", datanames = c("mtcars", "iris", "missing1", "missing2"))
+          )
+        ),
+        expr = {
+          session$setInputs(`teal_modules-active_tab` = "module_1")
+
+          testthat::expect_equal(
+            trimws(
+              rvest::html_text2(
+                rvest::read_html(
+                  output[["teal_modules-module_1-validate_datanames-shiny_warnings-message"]]$html
+                )
               )
-            )
-          ),
-          "Dataset iris is missing. No datasets are available in data."
-        )
-      }
-    )
+            ),
+            "Datasets missing1 and missing2 are missing. Datasets available in data: iris and mtcars."
+          )
+        }
+      )
+    })
+
+    testthat::it("warns about empty data when none of module$datanames is available (even if data is not empty)", {
+      testthat::skip_if_not_installed("rvest")
+      shiny::testServer(
+        app = srv_teal,
+        args = list(
+          id = "test",
+          data = teal_data(mtcars = mtcars),
+          modules = modules(
+            module("module_1", datanames = c("missing1", "missing2"))
+          )
+        ),
+        expr = {
+          session$setInputs(`teal_modules-active_tab` = "module_1")
+          testthat::expect_equal(
+            trimws(
+              rvest::html_text2(
+                rvest::read_html(
+                  output[["teal_modules-module_1-validate_datanames-shiny_warnings-message"]]$html
+                )
+              )
+            ),
+            "Datasets missing1 and missing2 are missing. No datasets are available in data."
+          )
+        }
+      )
+    })
+
+    testthat::it("warns about empty data when none of module$datanames is available", {
+      testthat::skip_if_not_installed("rvest")
+      shiny::testServer(
+        app = srv_teal,
+        args = list(
+          id = "test",
+          data = reactive(teal_data(mtcars = mtcars)),
+          modules = modules(
+            module("module_1", datanames = c("missing1", "missing2"))
+          )
+        ),
+        expr = {
+          session$setInputs(`teal_modules-active_tab` = "module_1")
+          testthat::expect_equal(
+            trimws(
+              rvest::html_text2(
+                rvest::read_html(
+                  output[["validate-shiny_warnings-message"]]$html
+                )
+              )
+            ),
+            "Datasets missing1 and missing2 are missing for module 'module_1'. Dataset available in data: mtcars."
+          )
+        }
+      )
+    })
   })
 
   testthat::it("is called and receives data even if datanames in `teal_data` are not sufficient", {