Throw informative warning if date coercion fails and original input

R/input-date.R

@@ -78,7 +78,7 @@
 #'
 #'   # Disable Mondays and Tuesdays.
 #'   dateInput("date7", "Date:", daysofweekdisabled = c(1,2)),
-#'   
+#'
 #'   # Disable specific dates.
 #'   dateInput("date8", "Date:", value = "2012-02-29",
 #'             datesdisabled = c("2012-03-01", "2012-03-02"))
@@ -92,10 +92,10 @@ dateInput <- function(inputId, label, value = NULL, min = NULL, max = NULL,
   language = "en", width = NULL, autoclose = TRUE,
   datesdisabled = NULL, daysofweekdisabled = NULL) {
 
-  value <- dateYMD(value)
-  min <- dateYMD(min)
-  max <- dateYMD(max)
-  datesdisabled <- dateYMD(datesdisabled)
+  value <- dateYMD(value, "value")
+  min <- dateYMD(min, "min")
+  max <- dateYMD(max, "max")
+  datesdisabled <- dateYMD(datesdisabled, "datesdisabled")
 
   value <- restoreInput(id = inputId, default = value)
 

R/input-daterange.R

@@ -76,10 +76,10 @@ dateRangeInput <- function(inputId, label, start = NULL, end = NULL,
     weekstart = 0, language = "en", separator = " to ", width = NULL,
     autoclose = TRUE) {
 
-  start <- dateYMD(start)
-  end   <- dateYMD(end)
-  min   <- dateYMD(min)
-  max   <- dateYMD(max)
+  start <- dateYMD(start, "start")
+  end   <- dateYMD(end, "end")
+  min   <- dateYMD(min, "min")
+  max   <- dateYMD(max, "max")
 
   restored <- restoreInput(id = inputId, default = list(start, end))
   start <- restored[[1]]

R/update-input.R

@@ -205,9 +205,9 @@ updateActionButton <- function(session, inputId, label = NULL, icon = NULL) {
 updateDateInput <- function(session, inputId, label = NULL, value = NULL,
                             min = NULL, max = NULL) {
 
-  value <- dateYMD(value)
-  min   <- dateYMD(min)
-  max   <- dateYMD(max)
+  value <- dateYMD(value, "value")
+  min   <- dateYMD(min, "min")
+  max   <- dateYMD(max, "max")
 
   message <- dropNulls(list(label=label, value=value, min=min, max=max))
   session$sendInputMessage(inputId, message)
@@ -258,10 +258,10 @@ updateDateRangeInput <- function(session, inputId, label = NULL,
                                  start = NULL, end = NULL, min = NULL,
                                  max = NULL) {
 
-  start <- dateYMD(start)
-  end <- dateYMD(end)
-  min <- dateYMD(min)
-  max <- dateYMD(max)
+  start <- dateYMD(start, "start")
+  end <- dateYMD(end, "end")
+  min <- dateYMD(min, "min")
+  max <- dateYMD(max, "max")
 
   message <- dropNulls(list(
     label = label,

R/utils.R

@@ -1565,11 +1565,19 @@ URLencode <- function(value, reserved = FALSE) {
 # function returns a string for consistency across locales.
 # Also, `as.Date()` is used to coerce strings to date objects
 # so that strings like "2016-08-9" are expanded to "2016-08-09"
-dateYMD <- function(date = NULL) {
+dateYMD <- function(date = NULL, argName = "value") {
   if (!length(date)) return(NULL)
   if (length(date) > 1) warning("Expected date to be of length 1.")
-  # Calling as.Date() on a date object does nothing
-  format(as.Date(date), "%Y-%m-%d")
+  tryCatch(format(as.Date(date), "%Y-%m-%d"),
+    error = function(e) {
+      warning(
+        "Couldn't coerce the `", argName,
+        "` argument to a date string with format yyy-mm-dd",
+        call. = FALSE
+      )
+      date
+    }
+  )
 }
 
 # This function takes a name and function, and it wraps that function in a new