Merge pull request #459 from Appsilon/458-dropdown-clear

458 dropdown clear

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: shiny.semantic
 Title: Semantic UI Support for Shiny
-Version: 0.5.0.9002
+Version: 0.5.0.9003
 Authors@R: c(person("Filip", "Stachura", email = "[email protected]", role = "aut"),
   person("Dominik", "Krzeminski", role = "aut"),
   person("Krystian", "Igras", role = "aut"),
@@ -51,6 +51,7 @@ Suggests:
     rcmdcheck,
     rmarkdown,
     testthat,
+    shinytest2,
     tibble,
     withr
 VignetteBuilder:

NEWS.md

@@ -6,6 +6,10 @@
 
 - `semantic_DT` now accepts style and class arguments.
 
+-  **Breaking change:** fixed `update_dropdown_input`.
+  - It now clears the dropdown on `value = character(0)` and `value = ""`.
+  - It now clears the dropdown on `choices` update.
+
 # [shiny.semantic 0.5.0](https://github.com/Appsilon/shiny.semantic/releases/tag/0.5.0)
 
 - `shiny.semantic` no longer uses CDN as the default source of assets. Instead, `semantic.assets` package was introduced.

R/dropdown.R

@@ -149,7 +149,17 @@ selectInput <- function(inputId, label, choices, selected = NULL, multiple = FAL
 #' @param input_id The id of the input object
 #' @param choices All available options one can select from. If no need to update then leave as \code{NULL}
 #' @param choices_value What reactive value should be used for corresponding choice.
-#' @param value The initially selected value.
+#' @param value A value to update dropdown to. Defaults to \code{NULL}.
+#' \itemize{
+#'   \item a value from \code{choices} updates the selection
+#'   \item \code{character(0)} and \code{""} clear the selection
+#'   \item \code{NULL}:
+#'   \itemize{
+#'     \item clears the selection if \code{choices} is provided
+#'     \item otherwise, \code{NULL} does not change the selection
+#'   }
+#'   \item a value not found in \code{choices} does not change the selection
+#' }
 #'
 #' @examples
 #' if (interactive()) {
@@ -177,17 +187,14 @@ selectInput <- function(inputId, label, choices, selected = NULL, multiple = FAL
 #'
 #' @export
 update_dropdown_input <- function(session, input_id, choices = NULL, choices_value = choices, value = NULL) {
-  if (!is.null(value)) value <- paste(as.character(value), collapse = ",") else value <- NULL
+  msg <- list()
+  if (!is.null(value)) {
+    msg$value <- paste(as.character(value), collapse = ",") # NOTE: paste() converts character(0) to ""
+  }
   if (!is.null(choices)) {
-    options <- jsonlite::toJSON(list(values = data.frame(name = choices, text = choices, value = choices_value)))
-  } else {
-    options <- NULL
+    msg$choices <- jsonlite::toJSON(list(values = data.frame(name = choices, text = choices, value = choices_value)))
   }
-
-  message <- list(choices = options, value = value)
-  message <- message[!vapply(message, is.null, FUN.VALUE = logical(1))]
-
-  session$sendInputMessage(input_id, message)
+  session$sendInputMessage(input_id, msg)
 }
 
 #' Change the value of a select input on the client

inst/www/shiny-semantic-dropdown.js

@@ -32,6 +32,10 @@ $.extend(semanticDropdownBinding, {
 
   // Given the DOM element for the input, set the value.
   setValue: function(el, value) {
+    if (value === '') {
+      $(el).dropdown('clear');
+      return;
+    }
     if ($(el).hasClass('multiple')) {
       $(el).dropdown('clear', true);
       value.split(",").map(v => $(el).dropdown('set selected', v));
@@ -59,22 +63,15 @@ $.extend(semanticDropdownBinding, {
   },
 
   receiveMessage: function(el, data) {
+    let value = data.value;
     if (data.hasOwnProperty('choices')) {
       // setup menu changes dropdown options without triggering onChange event
       $(el).dropdown('setup menu', data.choices);
-      // when no value passed, return null for multiple dropdown and first value for single one
-      if (!data.hasOwnProperty('value')) {
-        let value = ""
-        if (!$(el).hasClass('multiple')) {
-          value = data.choices.values[0].value
-        }
-        this.setValue(el, value);
-      }
+      // either keep the value provided or use the fact that an empty string clears the input and triggers a change event
+      value ||= ""
     }
 
-    if (data.hasOwnProperty('value')) {
-      this.setValue(el, data.value);
-    }
+    this.setValue(el, value);
 
     if (data.hasOwnProperty('label')) {
       $("label[for='" + el.id + "'").html(data.label);

tests/testthat/test_dropdown.R

@@ -17,3 +17,210 @@ test_that("test dropdown_input", {
   expect_false(any(grepl("<div class=\"item\" data-value=\"0\">0</div>",
                         si_str, fixed = TRUE)))
 })
+
+init_driver <- function(app) {
+  shinytest2::AppDriver$new(app)
+}
+
+test_app <- function(value, initial, multiple, choices = NULL) {
+  type <- if (multiple) "multiple" else ""
+  shiny::shinyApp(
+    ui = semanticPage(
+      dropdown_input("dropdown", LETTERS, value = initial, type = type),
+      shiny::actionButton("trigger", "Trigger")
+    ),
+    server = function(input, output, session) {
+      shiny::observeEvent(input$trigger, {
+        update_dropdown_input(session, "dropdown", value = value, choices = choices)
+      })
+    }
+  )
+}
+
+describe("update_dropdown_input", {
+  skip_on_cran()
+  local_edition(3)
+
+  it("is a no-op with NULL value", {
+    # Arrange
+    initial_value <- "A"
+    app <- init_driver(test_app(value = NULL, initial = initial_value, multiple = FALSE))
+    withr::defer(app$stop())
+
+    # Act
+    app$click("trigger")
+
+    # Assert
+    expect_equal(
+      app$get_value(input = "dropdown"),
+      initial_value
+    )
+  })
+
+  it("is a no-op with a value not in choices", {
+    # Arrange
+    initial_value <- "A"
+    app <- init_driver(test_app(value = "asdf", initial = initial_value, multiple = FALSE))
+    withr::defer(app$stop())
+
+    # Act
+    app$click("trigger")
+
+    # Assert
+    expect_equal(
+      app$get_value(input = "dropdown"),
+      initial_value
+    )
+  })
+
+  it("updates a single-selection dropdown with a new value", {
+    # Arrange
+    value <- "A"
+    app <- init_driver(test_app(value = value, initial = NULL, multiple = FALSE))
+    withr::defer(app$stop())
+
+    # Act
+    app$click("trigger")
+
+    # Assert
+    expect_equal(
+      app$get_value(input = "dropdown"),
+      value
+    )
+  })
+
+  it("updates a multi-selection dropdown with new values", {
+    # Arrange
+    value <- c("A", "B")
+    app <- init_driver(test_app(value = value, initial = NULL, multiple = TRUE))
+    withr::defer(app$stop())
+
+    # Act
+    app$click("trigger")
+
+    # Assert
+    expect_equal(
+      app$get_value(input = "dropdown"),
+      value
+    )
+  })
+
+  it("clears a single-selection dropdown with \"\" (empty string)", {
+    # Arrange
+    app <- init_driver(test_app(value = "", initial = "A", multiple = FALSE))
+    withr::defer(app$stop())
+
+    # Act
+    app$click("trigger")
+
+    # Assert
+    expect_equal(
+      app$get_value(input = "dropdown"),
+      ""
+    )
+  })
+
+  it("clears a multi-selection dropdown with \"\" (empty string)", {
+    # Arrange
+    app <- init_driver(test_app(value = "", initial = "A", multiple = TRUE))
+    withr::defer(app$stop())
+
+    # Act
+    app$click("trigger")
+
+    # Assert
+    expect_null(
+      app$get_value(input = "dropdown")
+    )
+  })
+
+  it("clears a single-selection dropdown with character(0)", {
+    # Arrange
+    app <- init_driver(test_app(value = character(0), initial = "A", multiple = FALSE))
+    withr::defer(app$stop())
+
+    # Act
+    app$click("trigger")
+
+    # Assert
+    expect_equal(
+      app$get_value(input = "dropdown"),
+      ""
+    )
+  })
+
+  it("clears a multi-selection dropdown with character(0)", {
+    # Arrange
+    app <- init_driver(test_app(value = character(0), initial = "A", multiple = TRUE))
+    withr::defer(app$stop())
+
+    # Act
+    app$click("trigger")
+
+    # Assert
+    expect_null(
+      app$get_value(input = "dropdown")
+    )
+  })
+
+  it("updates choices and clears selection in a single-selection dropdown when provided with choices and a NULL value", {
+    # Arrange
+    app <- init_driver(test_app(value = NULL, initial = "abc", multiple = FALSE, choices = c("abc", "xyz")))
+    withr::defer(app$stop())
+
+    # Act
+    app$click("trigger")
+
+    # Assert
+    expect_equal(
+      app$get_value(input = "dropdown"),
+      ""
+    )
+  })
+
+  it("updates choices and clears selection in a multi-selection dropdown when provided with choices and a NULL value", {
+    # Arrange
+    app <- init_driver(test_app(value = NULL, initial = "abc", multiple = TRUE, choices = c("abc", "xyz")))
+    withr::defer(app$stop())
+
+    # Act
+    app$click("trigger")
+
+    # Assert
+    expect_null(
+      app$get_value(input = "dropdown")
+    )
+  })
+
+  it("updates choices and sets selection in a single-selection dropdown when provided with both choices and a value", {
+    # Arrange
+    value <- "xyz"
+    app <- init_driver(test_app(value = value, initial = NULL, multiple = FALSE, choices = c("abc", "xyz")))
+    withr::defer(app$stop())
+
+    # Act
+    app$click("trigger")
+
+    # Assert
+    expect_equal(
+      app$get_value(input = "dropdown"),
+      value
+    )
+  })
+
+  it("updates choices and sets selection in a multi-selection dropdown when provided with both choices and a value", {
+    # Arrange
+    value <- c("abc", "xyz")
+    app <- init_driver(test_app(value = value, initial = NULL, multiple = TRUE, choices = c("abc", "xyz")))
+    withr::defer(app$stop())
+
+    # Act
+    app$click("trigger")
+
+    # Assert
+    expect_equal(
+      app$get_value(input = "dropdown"),
+      value
+    )
+  })
+})