inputSweetAlert(): allow javascript code, for example inputValidator …

…option

R/sweetalert.R

@@ -356,6 +356,7 @@ ask_confirmation <- function(inputId,
 #'  \code{"password"},\code{"textarea"}, \code{"radio"}, \code{"checkbox"} or \code{"select"}.
 #' @param inputOptions Options for the input. For \code{"radio"} and \code{"select"} it will be choices.
 #' @param inputPlaceholder Placeholder for the input, use it for \code{"text"} or \code{"checkbox"}.
+#' @param inputValidator JavaScript function to validate input. Must be a character wrapped in \code{I()}.
 #' @param btn_labels Label(s) for button(s).
 #' @param btn_colors Color(s) for button(s).
 #' @param reset_input Set the input value to \code{NULL} when alert is displayed.
@@ -383,6 +384,7 @@ inputSweetAlert <- function(session,
                                       "email", "url"),
                             inputOptions = NULL,
                             inputPlaceholder = NULL,
+                            inputValidator = NULL,
                             btn_labels = "Ok",
                             btn_colors = NULL,
                             reset_input = TRUE,
@@ -407,25 +409,30 @@ inputSweetAlert <- function(session,
   if (!is.null(inputOptions)) {
     inputOptions <- choicesWithNames(inputOptions)
   }
+  swal <- dropNullsOrNA(list(
+    title = title,
+    text = text,
+    icon = type,
+    input = input,
+    inputOptions = inputOptions,
+    inputPlaceholder = inputPlaceholder,
+    confirmButtonText = btn_labels[1],
+    confirmButtonColor = btn_colors[1],
+    cancelButtonText = btn_labels[2],
+    cancelButtonColor = btn_colors[2],
+    showCancelButton = !is.na(btn_labels[2]),
+    ...
+  ))
+  toeval <- unlist(lapply(swal, function(x) {
+    inherits(x, "AsIs")
+  }))
   session$sendCustomMessage(
     type = "sweetalert-sw-input",
     message = list(
       id = inputId,
       reset_input = reset_input,
-      swal = dropNullsOrNA(list(
-        title = title,
-        text = text,
-        icon = type,
-        input = input,
-        inputOptions = inputOptions,
-        inputPlaceholder = inputPlaceholder,
-        confirmButtonText = btn_labels[1],
-        confirmButtonColor = btn_colors[1],
-        cancelButtonText = btn_labels[2],
-        cancelButtonColor = btn_colors[2],
-        showCancelButton = !is.na(btn_labels[2]),
-        ...
-      ))
+      eval = list1(names(swal)[toeval]),
+      swal = swal
     )
   )
 }

examples/sweetalert-input.R

@@ -57,7 +57,14 @@ server <- function(input, output, session) {
       "myradio",
       input = "radio",
       inputOptions = c("Banana" , "Orange", "Apple"),
-      title = "What's your favorite fruit ?"
+      title = "What's your favorite fruit ?",
+      inputValidator = I(
+        "function(value) {
+          if (!value) {
+            return 'You need to choose something!';
+          }
+        }"
+      )
     )
   })
   output$radio <- renderPrint(input$myradio)

inst/assets/sweetalert2/sweetalert-bindings.js

@@ -1,5 +1,6 @@
 /*jshint
-  jquery:true
+  jquery:true,
+  evil: true
 */
 /*global Swal, CharacterData, DocumentType, Shiny */
 
@@ -68,6 +69,11 @@ Shiny.addCustomMessageHandler("sweetalert-sw-input", function(data) {
   if (data.reset_input) {
     Shiny.setInputValue(data.id, null);
   }
+  if (data.eval instanceof Array) {
+    $.each(data.eval, function (i, x) {
+      data.swal[x] = eval("(" + data.swal[x][0] + ")");
+    });
+  }
   Swal.fire(data.swal).then(function(result) {
     Shiny.setInputValue(data.id, result.value, { priority: "event" });
   });

tests/testthat/test-SweetAlert.R

@@ -128,7 +128,7 @@ test_that("inputSweetAlert", {
   sendIA_msg <- session$lastCustomMessage$message
 
   expect_identical(sendIA_msg$id, "MY_INPUT")
-  expect_length(sendIA_msg, 3)
+  expect_length(sendIA_msg, 4)
   expect_identical(sendIA_msg$swal$title, "TITLE")
   expect_is(sendIA_msg$swal$text, "json")
 })