fix: stop using internal functions inside the qenv

Author: vedhav

R/tm_p_spiderplot.R

@@ -283,7 +283,8 @@ srv_p_spiderplot <- function(id,
                   )
                 } else {
                   tooltip_lines <- sapply(tooltip_vars, function(col) {
-                    label <- .get_column_label(.data, col)
+                    label <- attr(dataname[[col]], "label")
+                    if (!length(label)) label <- col
                     value <- .data[[col]]
                     paste0(label, ": ", value)
                   })

R/tm_p_swimlane.R

@@ -244,23 +244,37 @@ srv_p_swimlane <- function(id,
             dplyr::group_by(!!as.name(subject_var), !!as.name(time_var)) %>%
             dplyr::mutate(
               tooltip = {
-                if (is.null(tooltip_vars)) {
-                  paste(
-                    unique(
-                      c(
-                        paste(subject_var_label, !!as.name(subject_var)),
-                        paste(time_var_label, !!as.name(time_var)),
-                        sprintf(
-                          "%s: %s",
-                          tools::toTitleCase(gsub("[^0-9A-Za-z]+", " ", !!as.name(group_var))),
-                          !!as.name(color_var)
-                        )
+                default_tip <- paste(
+                  unique(
+                    c(
+                      paste(subject_var_label, !!as.name(subject_var)),
+                      paste(time_var_label, !!as.name(time_var)),
+                      sprintf(
+                        "%s: %s",
+                        tools::toTitleCase(gsub("[^0-9A-Za-z]+", " ", !!as.name(group_var))),
+                        !!as.name(color_var)
                       )
-                    ),
-                    collapse = "<br>"
-                  )
+                    )
+                  ),
+                  collapse = "<br>"
+                )
+                if (is.null(tooltip_vars)) {
+                  default_tip
                 } else {
-                  .generate_tooltip(.data, tooltip_vars)
+                  cur_data <- dplyr::pick(dplyr::everything())
+                  cols <- intersect(tooltip_vars, names(cur_data))
+                  if (!length(cols)) {
+                    default_tip
+                  } else {
+                    sub <- cur_data[cols]
+                    labels <- vapply(cols, function(cn) {
+                      lb <- attr(sub[[cn]], "label")
+                      if (length(lb) && !is.null(lb) && !is.na(lb)) as.character(lb) else cn
+                    }, character(1))
+                    values <- lapply(sub, as.character)
+                    parts <- Map(function(v, l) paste0(l, ": ", v), values, labels)
+                    do.call(paste, c(parts, sep = "<br>"))
+                  }
                 }
               }
             ) %>%

R/tm_p_waterfall.R

@@ -204,15 +204,29 @@ srv_p_waterfall <- function(id,
             },
             !!as.name(subject_var) := factor(!!as.name(subject_var), levels = unique(!!as.name(subject_var))),
             tooltip = {
+              default_tip <- sprintf(
+                "%s: %s <br>%s: %s%% <br>%s: %s",
+                subject_var_label, !!as.name(subject_var),
+                value_var_label, !!as.name(value_var),
+                color_var_label, !!as.name(color_var)
+              )
               if (is.null(tooltip_vars)) {
-                sprintf(
-                  "%s: %s <br>%s: %s%% <br>%s: %s",
-                  subject_var_label, !!as.name(subject_var),
-                  value_var_label, !!as.name(value_var),
-                  color_var_label, !!as.name(color_var)
-                )
+                default_tip
               } else {
-                .generate_tooltip(.data, tooltip_vars)
+                cur_data <- dplyr::pick(dplyr::everything())
+                cols <- intersect(tooltip_vars, names(cur_data))
+                if (!length(cols)) {
+                  default_tip
+                } else {
+                  sub <- cur_data[cols]
+                  labels <- vapply(cols, function(cn) {
+                    lb <- attr(sub[[cn]], "label")
+                    if (length(lb) && !is.null(lb) && !is.na(lb)) as.character(lb) else cn
+                  }, character(1))
+                  values <- lapply(sub, as.character)
+                  parts <- Map(function(v, l) paste0(l, ": ", v), values, labels)
+                  do.call(paste, c(parts, sep = "<br>"))
+                }
               }
             }
           ) %>%

R/utils.R

@@ -433,26 +433,6 @@ children <- function(x, dataset_name = character(0)) {
   if (length(cs$choices) < 2) shinyjs::hide(inputId)
 }
 
-.get_column_label <- function(data, column) {
-  column_label <- attr(data[[column]], "label")
-  if (!length(column_label)) column_label <- column
-  column_label
-}
-
-
-.generate_tooltip <- function(data, tooltip_cols) {
-  tooltip_lines <- sapply(tooltip_cols, function(col) {
-    label <- .get_column_label(data, col)
-    value <- data[[col]]
-    paste0(label, ": ", value)
-  })
-  if (is.vector(tooltip_lines)) {
-    paste(tooltip_lines, collapse = "<br>")
-  } else {
-    apply(tooltip_lines, 1, function(row) paste(row, collapse = "<br>"))
-  }
-}
-
 
 #' @keywords internal
 #' @noRd