Merge pull request #37 from cynkra/f-improve-cell-message

F improve cell message

Author: olajoke

NAMESPACE

@@ -1,9 +1,11 @@
 # Generated by roxygen2: do not edit by hand
 
+export(add_cell_message)
 export(cheetah)
 export(cheetahOutput)
 export(column_def)
 export(column_group)
+export(js_ifelse)
 export(renderCheetah)
 import(htmlwidgets)
 import(jsonlite)

R/add_cell_message.R

@@ -0,0 +1,93 @@
+#' Create a JavaScript cell message function for cheetahR widgets
+#'
+#' Generates a JS function (wrapped with `htmlwidgets::JS`) that,
+#' given a record (`rec`), returns an object with `type` and `message`.
+#'
+#' @param type A string that specifies the type of message.
+#' One of `"error"`, `"warning"`, or `"info"`. Default is `"error"`.
+#' @param message A string or JS expression. If it contains `rec.`, `?`, `:`,
+#' or a trailing `;`, it is treated as raw JS (no additional quoting).
+#' Otherwise, it is escaped and wrapped in single quotes.
+#'
+#' @return A `htmlwidgets::JS` object containing a JavaScript function definition:
+#'```js
+#' function(rec) {
+#'   return {
+#'     type: "<type>",
+#'     message: <message>
+#'   };
+#' }
+#'```
+#' Use this within `column_def()` for cell validation
+#'
+#' @examples
+#' set.seed(123)
+#' iris_rows <- sample(nrow(iris), 10)
+#' data <- iris[iris_rows, ]
+#'
+#' # Simple warning
+#' cheetah(
+#'   data,
+#'   columns = list(
+#'     Species = column_def(
+#'       message = add_cell_message(type = "info", message = "Ok")
+#'     )
+#'   )
+#' )
+#'
+#' # Conditional error using `js_ifelse()`
+#' cheetah(
+#'   data,
+#'   columns = list(
+#'     Species = column_def(
+#'       message = add_cell_message(
+#'         message = js_ifelse(Species == "setosa", "", "Invalid")
+#'       )
+#'     )
+#'   )
+#' )
+#'
+#' # Directly using a JS expression as string
+#' cheetah(
+#'   data,
+#'   columns = list(
+#'     Sepal.Width = column_def(
+#'       style = list(textAlign = "left"),
+#'       message = add_cell_message(
+#'         type = "warning",
+#'         message = "rec['Sepal.Width'] <= 3 ? 'NarrowSepal' : 'WideSepal';"
+#'       )
+#'     )
+#'   )
+#' )
+#'
+#' @export
+add_cell_message <- function(
+  type = c("error", "warning", "info"),
+  message = "message"
+) {
+  type <- match.arg(type)
+
+  is_js_expr <- grepl("rec\\.|\\?|\\:|;$", message)
+  js_msg <- if (is_js_expr) {
+    sub(";$", "", message)
+  } else {
+    msg_esc <- gsub("'", "\\'", message)
+    paste0("'", msg_esc, "'")
+  }
+
+  js_fn <- paste0(
+    "function(rec) {\n",
+    "  return {\n",
+    "    type: '",
+    type,
+    "',\n",
+    "    message: ",
+    js_msg,
+    "\n",
+    "  };\n",
+    "}"
+  )
+
+  htmlwidgets::JS(js_fn)
+}

R/cheetah_utils.R

@@ -38,7 +38,8 @@
 #' takes `rec` as argument. It must return an object with two properties: `type` for the message
 #' type (`"info"`, `"warning"`, `"error"`) and the `message` that holds the text to display.
 #' The latter can leverage a JavaScript ternary operator involving `rec.<COLNAME>` (`COLNAME` being the name
-#' of the column for which we define the message) to check whether the predicate function is TRUE.
+#' of the column for which we define the message) to check whether the predicate function is TRUE. You can also
+#' use `add_cell_message()` to generated the expected JS expression.
 #' See details for example of usage.
 #'
 #' @details
@@ -57,6 +58,14 @@
 #'        }")
 #'     )
 #' ```
+#' Or use `add_cell_message()`:
+#' ```
+#'   <COLNAME> = column_def(
+#'     action = "input",
+#'      message = add_cell_message(type = "info", message = "Ok")
+#'     )
+#' ```
+#' See [add_cell_message()] for more details.
 #' @param sort Whether to sort the column. Default to FALSE. May also be
 #' a JS callback to create custom logic (does not work yet).
 #'

R/js_ifelse.R

@@ -0,0 +1,79 @@
+#' Convert an R logical expression into a JS ternary expression
+#'
+#' @param condition An R logical expression (supports %in% / %notin% / grepl() / comparisons / & |)
+#' @param if_true  String to return when the condition is TRUE. Default is an empty string, which interprets as `null` in JS.
+#' @param if_false String to return when the condition is FALSE. Default is an empty string, which interprets as `null` in JS.
+#' @return A single character string containing a JavaScript ternary expression.
+#' @export
+js_ifelse <- function(condition, if_true = "", if_false = "") {
+  # 1) Capture the unevaluated condition as a single string
+  txt <- paste(deparse(substitute(condition)), collapse = " ")
+
+  # 2) Force all " to ' in the condition itself
+  txt <- gsub("\"", "'", txt, fixed = TRUE)
+
+  # 3) Handle %notin% and %in%
+  handle_in <- function(text) {
+    pat <- "(\\b[[:alnum:]_.]+)\\s*%(not)?in%\\s*c\\(([^)]+)\\)"
+    matches <- gregexpr(pat, text, perl = TRUE)[[1]]
+    if (matches[1] == -1) return(text)
+
+    for (raw in regmatches(text, gregexpr(pat, text, perl = TRUE))[[1]]) {
+      parts <- regmatches(raw, regexec(pat, raw, perl = TRUE))[[1]]
+      var   <- parts[2]
+      neg   <- !is.na(parts[3]) && nzchar(parts[3])
+      vals  <- strsplit(parts[4], ",")[[1]]
+      vals  <- trimws(gsub("^['\"]|['\"]$", "", vals))
+
+      # build a single-quoted JS array literal
+      arr   <- sprintf("['%s']", paste(vals, collapse = "','"))
+      expr  <- sprintf("%s.includes(rec['%s'])", arr, var)
+      if (neg) expr <- paste0("!", expr)
+
+      text <- sub(pat, expr, text, perl = TRUE)
+    }
+    text
+  }
+  txt <- handle_in(txt)
+
+  # 4) Handle grepl() and !grepl(), capturing the inner regex
+  handle_grep <- function(text) {
+    pat <- "(!?)grepl\\((['\"])(.*?)\\2,\\s*([[:alnum:]_.]+)\\)"
+    matches <- gregexpr(pat, text, perl = TRUE)[[1]]
+    if (matches[1] == -1) return(text)
+
+    for (raw in regmatches(text, gregexpr(pat, text, perl = TRUE))[[1]]) {
+      parts <- regmatches(raw, regexec(pat, raw, perl = TRUE))[[1]]
+      notp    <- nzchar(parts[2])
+      pattern <- parts[4]
+      var     <- parts[5]
+
+      expr <- sprintf("%s/%s/.test(rec['%s'])",
+                      if (notp) "!" else "", pattern, var)
+      text <- sub(pat, expr, text, perl = TRUE)
+    }
+    text
+  }
+  txt <- handle_grep(txt)
+
+  # 5) Replace R logical operators with JS equivalents
+  txt <- gsub("!=", "!==", txt, fixed = TRUE)
+  txt <- gsub("==", "===",  txt, fixed = TRUE)
+  txt <- gsub(" & ", " && ", txt, fixed = TRUE)
+  txt <- gsub(" | ", " || ", txt, fixed = TRUE)
+
+  # 6) Prefix all remaining bare names with rec['...'], skipping 'rec' itself
+  prefix_pat <- "(?<![\\w'\"/\\[\\]])\\b(?!rec\\b)([A-Za-z_][A-Za-z0-9_.]*)\\b(?![\\]\\('\"/])"
+  txt <- gsub(prefix_pat, "rec['\\1']", txt, perl = TRUE)
+
+  # 7) Wrap the true/false results in single quotes (or null)
+  wrap <- function(x) {
+    x2 <- gsub("\"", "'", x, fixed = TRUE)
+    if (x2 == "") "null" else sprintf("'%s'", x2)
+  }
+  tval <- wrap(if_true)
+  fval <- wrap(if_false)
+
+  # 8) Assemble and return the JS ternary
+  sprintf("%s ? %s : %s;", txt, tval, fval)
+}

man/add_cell_message.Rd

@@ -0,0 +1,45 @@
+test_that("js_ifelse conversion", {
+  # Simple logic: numeric comparisons and equality
+  expect_equal(
+    js_ifelse(Sepal.Length > 5, "BigSepal", ""),
+    "rec['Sepal.Length'] > 5 ? 'BigSepal' : null;"
+  )
+  expect_equal(
+    js_ifelse(Species == "setosa", "IsSetosa", ""),
+    "rec['Species'] === 'setosa' ? 'IsSetosa' : null;"
+  )
+  expect_equal(
+    js_ifelse(Sepal.Width <= 3, "NarrowSepal", "WideSepal"),
+    "rec['Sepal.Width'] <= 3 ? 'NarrowSepal' : 'WideSepal';"
+  )
+
+  # Combined logic
+  expr <- js_ifelse(Sepal.Length > 5 & Species %notin% c("setosa"), "E", "X")
+  expect_true(grepl("rec['Sepal.Length'] > 5 && !['setosa'].includes", expr, fixed = TRUE))
+
+  # Truthiness of bare variable
+  expect_equal(
+    js_ifelse(Species, "", "Please check."),
+    "rec['Species'] ? null : 'Please check.';"
+  )
+
+  # Basic %in%  and  %notin%
+  expect_equal(
+    js_ifelse(Species %in% c("setosa", "virginica"), "Bad", ""),
+    "['setosa',''virginica'].includes(rec['Species']) ? 'Bad' : null;"
+  )
+  expect_equal(
+    js_ifelse(Species %notin% c("setosa"), "OK", ""),
+    "!['setosa'].includes(rec['Species']) ? 'OK' : null;"
+  )
+
+  # grepl() and !grepl()
+  expect_equal(
+    js_ifelse(grepl("^vir", Species), "Yes", ""),
+    "/^vir/.test(rec['Species']) ? 'Yes' : null;"
+  )
+  expect_equal(
+    js_ifelse(!grepl("set", Species), "NoSet", ""),
+    "!/set/.test(rec['Species']) ? 'NoSet' : null;"
+  )
+})