Merge pull request #34 from cynkra/19-inline-menu-editor

19 inline menu editor

Author: olajoke

R/cheetah.R

@@ -47,8 +47,9 @@ cheetah <- function(
       is_named_list(columns) & names(columns) %in% colnames(data)
   )
 
-  columns <- update_col_list_with_classes(data, columns) %>%
-    add_field_to_list()
+  columns <-
+    update_col_list_with_classes(data, columns) %>%
+      add_field_to_list()
 
   data_json <- toJSON(data, dataframe = "rows")
   # forward options using x

R/cheetah_utils.R

@@ -7,24 +7,32 @@
 #' @param width Column width.
 #' @param min_width Column minimal width.
 #' @param max_width Column max width.
-#' @param column_type Column type. There are 6 possible options:
+#' @param column_type Column type. By default, the column type is inferred from the data type of the column.
+#' There are 7 possible options:
 #' \itemize{
 #'   \item \code{"text"} for text columns.
 #'   \item \code{"number"} for numeric columns.
 #'   \item \code{"check"} for check columns.
 #'   \item \code{"image"} for image columns.
 #'   \item \code{"radio"} for radio columns.
-#'   \item \code{"multilinetext"} for multiline text in columns.
+#'   \item \code{"multilinetext"} for multiline text columns.
+#'   \item \code{"menu"} for menu selection columns. If \code{column_type == "menu"},
+#'    action parameter must be set to "inline_menu" and menu_options must be provided.
+#'    Note: Works efficiently only in shiny.
 #' }
 #' @param action The action property defines column actions. Select
-#' the appropriate Action class for the column type. For instance,
-#' if the column type is \code{"text"}, the action can be \code{"input"}.
-#' There are 3 supported actions:
+#' the appropriate Action class for the column type.
 #' \itemize{
 #'   \item \code{"input"} for input action columns.
 #'   \item \code{"check"} for check action columns.
 #'   \item \code{"radio"} for radio action columns.
+#'   \item \code{"inline_menu"} for menu selection columns.
 #' }
+#' @param menu_options A list of menu options when using \code{column_type = "menu"}.
+#' Each option should be a list with \code{value} and \code{label} elements.
+#' The menu options must be a list of lists, each containing a \code{value}
+#' and \code{label} element.
+#' The \code{label} element is the label that will be displayed in the menu.
 #' @param style Column style.
 #' @param message Cell message. Expect a [htmlwidgets::JS()] function that
 #' takes `rec` as argument. It must return an object with two properties: `type` for the message
@@ -61,21 +69,46 @@ column_def <- function(
   max_width = NULL,
   column_type = NULL,
   action = NULL,
+  menu_options = NULL,
   style = NULL,
   message = NULL,
   sort = FALSE
 ) {
   check_column_type(column_type)
+  check_action_type(action, column_type)
+  in_shiny <- shiny::isRunning()
+
+  if (all(!is.null(column_type), column_type == "menu", !in_shiny)) {
+    warning(
+      "Dropdown menu action does not work properly outside a shiny environment"
+    )
+  }
+
+  if (
+    all(!is.null(column_type), column_type == "menu", is.null(menu_options))
+  ) {
+    stop("menu_options must be provided when column_type is 'menu'")
+  }
+
   if (!is.null(message) && !inherits(message, "JS_EVAL"))
     stop("message must be a JavaScript function wrapped by htmlwidgets::JS().")
+
   list(
     caption = name,
     width = width,
     minWidth = min_width,
     maxWidth = max_width,
     columnType = column_type,
-    action = action,
-    style = style,
+    action = if (!is.null(action)) {
+      if (action == "inline_menu") {
+        list(
+          type = action,
+          options = menu_options
+        )
+      } else {
+        action
+      }
+    },
     message = message,
     sort = sort
   )

R/utils.R

@@ -1,3 +1,8 @@
+is_testing <- function ()
+{
+  identical(Sys.getenv("TESTTHAT"), "true")
+}
+
 is_named_list <- function(x) {
   is.list(x) && !is.null(names(x)) && all(names(x) != "")
 }
@@ -66,7 +71,7 @@ column_style_check <- function(columns) {
 
 check_column_type <- function(x) {
   av_options <-
-    c("text", "check", "number", "radio", "image", "multilinetext")
+    c("text", "check", "number", "radio", "image", "multilinetext", "menu")
 
   if (!is.null(x) && !(x %in% av_options)) {
     msg <- sprintf(
@@ -80,11 +85,24 @@ check_column_type <- function(x) {
 
 update_col_list_with_classes <- function(data, col_list) {
   col_classes <- lapply(data, class)
+  in_shiny <- shiny::isRunning()
+  is_testing <- is_testing()
 
   for (col_name in names(col_classes)) {
     if (is.null(col_list[[col_name]]$columnType)) {
       if (col_classes[[col_name]] == "numeric") {
         col_list[[col_name]]$columnType <- "number"
+      } else if (col_classes[[col_name]] == "factor" && any(in_shiny, is_testing)) {
+        # This is to recover the possible choices for a factor column.
+        menu_opt <- lapply(
+          unique(data[[col_name]]),
+          \(val) {
+            list(value = val, label = val)
+          }
+        )
+        col_list[[col_name]]$columnType <- "menu"
+        col_list[[col_name]]$action <-
+          list(type = "inline_menu", options = menu_opt)
       } else {
         col_list[[col_name]]$columnType <- "text"
       }
@@ -93,3 +111,18 @@ update_col_list_with_classes <- function(data, col_list) {
 
   col_list
 }
+
+check_action_type <- function(action = NULL, column_type = NULL) {
+  if (is.null(action)) return(invisible())
+
+  valid_actions <- c("input", "check", "radio", "inline_menu")
+  if (!action %in% valid_actions) {
+    stop("Invalid action type. Must be one of: ",
+         paste(valid_actions, collapse = ", "))
+  }
+
+  # Validate action-column type compatibility
+  if (action == "inline_menu" && any(is.null(column_type), column_type != "menu")) {
+    stop("'inline_menu' action can only be used with 'menu' column type")
+  }
+}

inst/htmlwidgets/cheetah.js

@@ -31,8 +31,23 @@ HTMLWidgets.widget({
             ...(userMap[item.field] || {})
           }));
 
+          // Iterate over the list and process the `action` property if it is not null or undefined
+          columns.forEach((obj) => {
+            if (obj.action != null) {  // Checks for both null and undefined
+              if (obj.action.type === "inline_menu") {
+                obj.columnType = new cheetahGrid.columns.type.MenuColumn({
+                  options: obj.action.options,
+                });
+
+                obj.action = new cheetahGrid.columns.action.InlineMenuEditor({
+                  options: obj.action.options,
+                });
+              }
+            }
+          });
+
         } else {
-          columns = defaultCol
+          columns = defaultCol;
         }
 
         const grid = new cheetahGrid.ListGrid({

man/column_def.Rd

@@ -39,11 +39,15 @@ test_that("test column style check", {
 
 test_that("update_col_list_with_classes sets columnType correctly", {
   data <- data.frame(
-    full_name = c("Alan Smith", "Mike John", "John Doe"),
-    grade = c(78, 52, 3),
-    passed = c(TRUE, FALSE, TRUE)
+    full_name = c("Anne Smith", "Mike John", "John Doe", "Janet Jones"),
+    grade = c(78, 52, 3, 27),
+    passed = c(TRUE, TRUE, FALSE, FALSE),
+    gender = c("female", "male", "male", "female")
   )
 
+  # Set 'gender' to a factor column
+  data$gender <- as.factor(data$gender)
+
   columns <- list(
     passed = list(columnType = "check"),
     full_name = list(name = "Names")
@@ -59,4 +63,8 @@ test_that("update_col_list_with_classes sets columnType correctly", {
 
   # Column 'full_name' is (non-numeric), columnType becomes "text"
   expect_equal(updated_col_list$full_name$columnType, "text")
+
+  # Column 'gender' is a factor, columnType becomes "menu" and action to "inline_menu"
+  expect_equal(updated_col_list$gender$columnType, "menu")
+  expect_equal(updated_col_list$gender$action$type, "inline_menu")
 })

srcjs/widgets/cheetah.js

@@ -67,8 +67,9 @@ The `column_type` parameter in `column_def()` allows you to specify different ty
 - `"image"`: For image columns
 - `"radio"`: For radio button columns
 - `"multilinetext"`: For multiline text columns
+- `"menu"`: For dropdown menu selection columns
 
-The `column_type` parameter is optional. If it is not specified, the column type will be inferred from the data type.
+If `column_type` parameter is optional. If it is not specified, the column type will be inferred from the data type.
 
 ```{r}
 # Using checkbox column type to indicate NA values
@@ -165,3 +166,64 @@ cheetah(
   )
 )
 ```
+
+
+## `cheetah()` usage in Shiny
+cheetahR works seamlessly in a Shiny app. You can use it in both the UI and server components. In the UI, simply call `cheetahR::cheetahOutput()` to create a placeholder for the grid. In the server, use `cheetahR::renderCheetah()` to render the grid with your data and options.
+
+The grid will automatically update when the underlying data changes, making it perfect for reactive applications. All features like filtering, sorting, and custom column definitions work exactly the same way as in standalone R usage.
+
+
+One special feature that works particularly well in Shiny is the `menu` column type, which allows users to select from predefined options in a dropdown menu. This is ideal for interactive data editing workflows.
+
+## Menu column in Shiny
+By default, `cheetah()` automatically detects any "factor" columns in your data and converts them into menu columns. A menu column displays a dropdown menu with predefined options that users can select from. This is particularly useful when you want to restrict input to a specific set of valid choices. For example, if you have a factor column with levels "Low", "Medium", and "High", it will be displayed as a dropdown menu with these three options.
+```{r, eval=FALSE}
+library(shiny)
+library(bslib)
+library(cheetahR)
+
+
+ui <- page_fluid(cheetahOutput("grid"))
+
+server <- function(input, output) {
+  output$grid <- renderCheetah({
+    cheetah(data = iris)
+  })
+}
+
+shinyApp(ui = ui, server = server)
+```
+![Default menu column sample 1](figures/default_menucolumn_img_1.png)
+
+![Default menu column sample 2](figures/default_menucolumn_img_2.png)
+
+### Customizing the 'menu options'
+```{r, eval=FALSE}
+library(shiny)
+library(bslib)
+library(cheetahR)
+
+ui <- page_fluid(cheetahOutput("grid"))
+
+server <- function(input, output) {
+  output$grid <- renderCheetah({
+    cheetah(data = iris,
+            columns = list(
+              Species = column_def(
+                column_type = "menu",
+                action = "inline_menu",
+                menu_options = list(
+                  setosa = "Option Setosa",
+                  versicolor = "Option Vericolor" ,
+                  virginica = "Option Virginica"
+                )
+              )
+            )
+          )
+  })
+}
+
+shinyApp(ui = ui, server = server)
+```
+![Customized menu column sample ](figures/customized_menucolumn_img.png)