feat: introduce CommandBar.shinyInput

DESCRIPTION

@@ -25,6 +25,7 @@ Depends:
 Imports:
   htmltools,
   jsonlite,
+  purrr,
   rlang,
   shiny,
   shiny.react (>= 0.3.0)
@@ -39,7 +40,6 @@ Suggests:
   leaflet,
   mockery,
   plotly,
-  purrr,
   rcmdcheck,
   RColorBrewer,
   rmarkdown,

NAMESPACE

@@ -19,6 +19,7 @@ export(ColorPicker.shinyInput)
 export(ComboBox)
 export(ComboBox.shinyInput)
 export(CommandBar)
+export(CommandBar.shinyInput)
 export(CommandBarButton)
 export(CommandBarButton.shinyInput)
 export(CommandBarItem)

R/extensions.R

@@ -1,3 +1,18 @@
+setInputValue <- function(inputId, value, event = TRUE) {
+  fmt <- if (event) {
+    "() => Shiny.setInputValue('%s', %s, { priority: 'event' })"
+  } else {
+    "() => Shiny.setInputValue('%s', %s)"
+  }
+  JS(sprintf(fmt, inputId, if (!is.numeric(value)) sprintf("'%s'", value) else value))
+}
+
+commandBarItem <- "CommandBarItem"
+
+isCommandBarItem <- function(x) {
+  isTRUE(attr(x, "componentName") == commandBarItem)
+}
+
 #' Command bar item
 #'
 #' Helper function for constructing items for `CommandBar`.
@@ -10,18 +25,52 @@
 #' @param text Text to be displayed on the menu.
 #' @param icon Optional name of an icon.
 #' @param subitems Optional list of CommandBar items.
+#' @param onClick A JS function that runs on item click. By default it sends input value to `input[[key]]`
 #' @param ... Additional props to pass to CommandBarItem.
 #' @return Item suitable for use in the CommandBar.
 #'
 #' @seealso CommandBar
 #' @export
-CommandBarItem <- function(text, icon = NULL, subitems = NULL, ...) {
-  props <- rlang::dots_list(...)
+CommandBarItem <- function(
+  key,
+  text,
+  onClick = setInputValue(inputId = key, value = 0),
+  ...
+) {
+  structure(
+    list(
+      key = key,
+      text = text,
+      onClick = onClick,
+      ...
+    ),
+    componentName = commandBarItem
+  )
+}
 
-  props$text <- text
-  if (is.character(icon)) props$iconProps <- list(iconName = icon)
-  if (!is.null(subitems)) props$subMenuProps <- list(items = subitems)
-  props
+#' CommandBar.shinyInput
+#'
+#' CommandBar extension that sends values of clicked CommandBarItems
+#'
+#' @params inputId Input name
+#' @return A CommandBar
+#'
+#' @seealso CommandBarItem
+#' @rdname CommandBar
+#' @export
+CommandBar.shinyInput <- function(
+  inputId,
+  ...,
+  itemValueGetter = function(el) el$key
+) {
+  attachOnClick <- function(el) {
+    el$onClick <- setInputValue(inputId, itemValueGetter(el))
+    el
+  }
+  args <- list(...)
+  args$items <- recursiveModify(args$items, attachOnClick, isCommandBarItem)
+  args$farItems <- recursiveModify(args$farItems, attachOnClick, isCommandBarItem)
+  do.call(CommandBar, args)
 }
 
 #' Basic Fluent UI page

R/utils.R

@@ -0,0 +1,12 @@
+recursiveModify <- function(x, modify = identity, when = function(x) TRUE) {
+  purrr::modify_tree(
+    x,
+    pre = function(el) {
+      if (!is.null(el) && when(el)) {
+        return(modify(el))
+      }
+      el
+    },
+    is_node = is.list
+  )
+}

inst/examples/CommandBar.R

@@ -1,69 +1,91 @@
 library(shiny)
 library(shiny.fluent)
 
-items <- list(
+items <- function(ns) {
   list(
-    key = "newItem",
-    text = "New",
-    cacheKey = "myCacheKey",
-    iconProps = list(iconName = "Add"),
-    subMenuProps = list(
-      items = list(
-        list(
-          key = "emailMessage",
-          text = "Email message",
-          iconProps = list(iconName = "Mail")
-        ),
-        list(
-          key = "calendarEvent",
-          text = "Calendar event",
-          iconProps = list(iconName = "Calendar")
+    CommandBarItem(
+      key = ns("newItem"),
+      text = "New",
+      cacheKey = "myCacheKey",
+      split = TRUE,
+      iconProps = list(iconName = "Add"),
+      subMenuProps = list(
+        items = list(
+          CommandBarItem(
+            key = ns("emailMessage"),
+            text = "Email message",
+            iconProps = list(iconName = "Mail")
+          ),
+          CommandBarItem(
+            key = ns("calendarEvent"),
+            text = "Calendar event",
+            iconProps = list(iconName = "Calendar")
+          )
         )
       )
+    ),
+    CommandBarItem(
+      key = ns("upload"),
+      text = "Upload",
+      iconProps = list(iconName = "Upload")
+    ),
+    CommandBarItem(
+      key = ns("share"),
+      text = "Share",
+      iconProps = list(iconName = "Share")
+    ),
+    CommandBarItem(
+      key = ns("download"),
+      text = "Download",
+      iconProps = list(iconName = "Download")
     )
-  ),
-  list(
-    key = "upload",
-    text = "Upload",
-    iconProps = list(iconName = "Upload")
-  ),
-  list(
-    key = "share",
-    text = "Share",
-    iconProps = list(iconName = "Share")
-  ),
-  list(
-    key = "download",
-    text = "Download",
-    iconProps = list(iconName = "Download")
   )
-)
+}
 
-farItems <- list(
-  list(
-    key = "tile",
-    text = "Grid view",
-    ariaLabel = "Grid view",
-    iconOnly = TRUE,
-    iconProps = list(iconName = "Tiles")
-  ),
+farItems <- function(ns) {
   list(
-    key = "info",
-    text = "Info",
-    ariaLabel = "Info",
-    iconOnly = TRUE,
-    iconProps = list(iconName = "Info")
+    CommandBarItem(
+      key = ns("tile"),
+      text = "Grid view",
+      ariaLabel = "Grid view",
+      iconOnly = TRUE,
+      iconProps = list(iconName = "Tiles")
+    ),
+    CommandBarItem(
+      key = ns("info"),
+      text = "Info",
+      ariaLabel = "Info",
+      iconOnly = TRUE,
+      iconProps = list(iconName = "Info")
+    )
   )
-)
-
+}
 
 ui <- function(id) {
   ns <- NS(id)
-  CommandBar(items = items, farItems = farItems)
+  tagList(
+    CommandBar(
+      items = items(ns),
+      farItems = farItems(ns)
+    ),
+    textOutput(ns("commandBarItems")),
+    CommandBar.shinyInput(
+      inputId = ns("commandBar"),
+      items = items(identity),
+      farItems = farItems(identity)
+    ),
+    textOutput(ns("commandBar"))
+  )
 }
 
 server <- function(id) {
-  moduleServer(id, function(input, output, session) { })
+  moduleServer(id, function(input, output, session) {
+    commandBarItemClicked <- reactiveVal()
+    observeEvent(input$newItem, commandBarItemClicked("newItem clicked"))
+    observeEvent(input$upload, commandBarItemClicked("upload clicked"))
+    output$commandBarItems <- renderText(commandBarItemClicked())
+    output$commandBar <- renderText(input$commandBar)
+  })
 }
 
 if (interactive()) {