Skip to content

Commit

Permalink
Improves datanames error message (#1297)
Browse files Browse the repository at this point in the history
Part of #1253

### Changes description

- `check_modules_datanames` returns a string and HTML generator for:
    - **string**: to be used with logger 
    - **HTML**: function to be used in teal UI
- Message is generated in the same way. This adds complexity, but is
consistent
- `c("one", "two", "three")` renders as "one, two and three" (note the
comma and `and`)
- In the module context it doesn't show the current module label

<details>

<summary>Sample app</summary>

```r
options(
  teal.log_level = "TRACE",
  teal.show_js_log = TRUE,
  # teal.bs_theme = bslib::bs_theme(version = 5),
  shiny.bookmarkStore = "server"
)

pkgload::load_all("teal.data")
pkgload::load_all("teal.slice")
pkgload::load_all("teal")

my_transformers <- list(
  teal_transform_module(
    label = "reactive ADSL",
    ui = function(id) {
      ns <- NS(id)
      tagList(
        div("Some UI for transform (merge)"),
        actionButton(ns("btn"), "Reload data")
      )
    },
    server = function(id, data) {
      moduleServer(id, function(input, output, session) {
        eventReactive(input$btn, {
          data()
        })
      })
    }
  ),
  teal_transform_module(
    label = "Keep first 6 from IRIS",
    ui = function(id) {
      ns <- NS(id)
      div(
        span("Some UI for transform (1)"),
        textInput(ns("obs"), label = "Number of rows", value = 6)
      )
    },
    server = function(id, data) {
      moduleServer(id, function(input, output, session) {
        reactive({
          req(data())
          obs <- as.numeric(input$obs)
          if (!is.finite(obs)) stop("NOT NUMERIC.")
          within(data(), iris <- head(iris, n), n = as.numeric(input$obs))
        })
      })
    }
  ),
  teal_transform_module(
    label = "Keep first 6 from ADTTE",
    ui = function(id) div("Some UI for transform 2"),
    server = function(id, data) {
      moduleServer(id, function(input, output, session) {
        reactive({
          req(data())
          within(data(), ADTTE <- head(ADTTE))
        })
      })
    }
  )
)

data <- teal_data_module(
  once = FALSE,
  ui = function(id) {
    ns <- NS(id)
    tagList(
      numericInput(ns("obs"), "Number of observations to show", 1000),
      actionButton(ns("submit"), label = "Submit")
    )
  },
  server = function(id, ...) {
    moduleServer(id, function(input, output, session) {
      logger::log_trace("example_module_transform2 initializing.")
      eventReactive(input$submit, {
        data <- teal_data() |>
          within(
            {
              logger::log_trace("Loading data")
              ADSL <- head(teal.data::rADSL, n = n)
              ADTTE <- teal.data::rADTTE
              iris <- iris
              
              CO2 <- CO2
              factors <- names(Filter(isTRUE, vapply(CO2, is.factor, logical(1L))))
              CO2[factors] <- lapply(CO2[factors], as.character)
            },
            n = as.numeric(input$obs)
          )
        join_keys(data) <- default_cdisc_join_keys[c("ADSL", "ADTTE")]
        teal.data::datanames(data) <- c("ADSL", "ADTTE", "iris", "CO2")
        data
      })
    })
  }
)

teal::init(
  data = data,
  modules = list(
    example_module("mod-1", datanames = "all"),
    example_module("mod-2", transformers = my_transformers, datanames = c("ADSL", "ADTTE", "iris", "elo")),
    modules(
      label = "sub-modules",
      example_module("mod-2-sub1", transformers = my_transformers, datanames = c("ADSL", "ADTTE", "iris", "elo", "elo2")),
      example_module("mod-2-sub2", transformers = my_transformers, datanames = c("ADSL", "ADTTE", "iris", "elo"))
    ),
    example_module("mod-2", transformers = my_transformers[2:3])
  ),
  filter = teal_slices(
    teal_slice("ADSL", "SEX"),
    teal_slice("ADSL", "AGE", selected = c(18L, 65L))
  )
) |>
  runApp()
```

</details>


![image](https://github.com/user-attachments/assets/9a6c09a6-2ce4-4c2b-b7f6-0cce7ab8670c)


![image](https://github.com/user-attachments/assets/2b4a8dd1-f7e7-44f8-80d3-9cb45dd3909b)
  • Loading branch information
averissimo authored Aug 12, 2024
1 parent 971dd59 commit a6b21f8
Show file tree
Hide file tree
Showing 4 changed files with 100 additions and 16 deletions.
2 changes: 1 addition & 1 deletion R/init.R
Original file line number Diff line number Diff line change
Expand Up @@ -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))
Expand Down
9 changes: 7 additions & 2 deletions R/module_teal_data.R
Original file line number Diff line number Diff line change
Expand Up @@ -151,7 +151,6 @@ srv_validate_reactive_teal_data <- function(id, # nolint: object_length
)
)


data_out
})

Expand All @@ -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"
)
}
}
})
Expand Down
94 changes: 86 additions & 8 deletions R/utils.R
Original file line number Diff line number Diff line change
Expand Up @@ -119,22 +119,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
}
Expand Down Expand Up @@ -288,3 +314,55 @@ 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) {

Check warning on line 322 in R/utils.R

View workflow job for this annotation

GitHub Actions / SuperLinter 🦸‍♀️ / Lint R code 🧶

file=R/utils.R,line=322,col=39,[object_name_linter] Variable and function name style should match snake_case or symbols.
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) {

Check warning on line 346 in R/utils.R

View workflow job for this annotation

GitHub Actions / SuperLinter 🦸‍♀️ / Lint R code 🧶

file=R/utils.R,line=346,col=43,[object_name_linter] Variable and function name style should match snake_case or symbols.
tags$span(
tags$span(ifelse(length(extra_datanames) > 1, "Datasets", "Dataset")),
paste_datanames_character(extra_datanames, tags, tagList),
tags$span(ifelse(length(extra_datanames) > 1, "are missing", "is missing")),
tags$span(
paste(
ifelse(is.null(label), ".", sprintf("for tab '%s'.", label))
),
.noWS = c("before")
),
if (length(datanames) >= 1) {
tagList(
tags$span(ifelse(length(datanames) > 1, "Datasets", "Dataset")),
tags$span("available in data:"),
tags$span(paste_datanames_character(datanames, tags, tagList)),
tags$span(".", .noWS = "before")
)
} else {
tags$span("No datasets are available in data.")
}
)
}
11 changes: 6 additions & 5 deletions inst/css/validation.css
Original file line number Diff line number Diff line change
Expand Up @@ -21,23 +21,24 @@

.teal_validated .teal-output-warning::before {
content: "\26A0\FE0F";
padding-right: 0.5em;
}

.teal_validated .shiny-output-error::before {
content: "\1F6A8";
padding-right: 0.5em;
}

.teal_primary_col .teal-output-warning::before {
.teal_primary_col .shiny-output-error::before {
content: "\1F6A8";
padding-right: 0.5em;
}

.teal_primary_col .teal-output-warning::before {
content: "\26A0\FE0F";
}

.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),
Expand Down

0 comments on commit a6b21f8

Please sign in to comment.