Create a user-extensible registry of custom Shiny Input handlers.

Brought in the existing handlers for date, matrix, and numeric. Allow users to add/remove handlers via the new addInputHandler and removeInputHandler functions. The addInputHandler function accepts a callback which wil be called with the input value, shinysession object, and element name.

NAMESPACE

@@ -22,6 +22,7 @@ S3method(print,shiny.tag.list)
 export(HTML)
 export(a)
 export(actionButton)
+export(addInputHandler)
 export(addResourcePath)
 export(animationOptions)
 export(basicPage)
@@ -80,6 +81,7 @@ export(reactiveTimer)
 export(reactiveUI)
 export(reactiveValues)
 export(reactiveValuesToList)
+export(removeInputHandler)
 export(renderImage)
 export(renderPlot)
 export(renderPrint)

R/shiny.R

@@ -793,6 +793,85 @@ staticHandler <- function(root) {
 
 appsByToken <- Map$new()
 
+# Create a map for input handlers and register the defaults.
+inputHandlers <- Map$new()
+
+# Takes a list-of-lists and returns a matrix. The lists
+# must all be the same length. NULL is replaced by NA.
+inputHandlers$set("matrix", function(data, ...) {
+  if (length(data) == 0)
+    return(matrix(nrow=0, ncol=0))
+
+  m <- matrix(unlist(lapply(data, function(x) {
+    sapply(x, function(y) {
+      ifelse(is.null(y), NA, y)
+    })
+  })), nrow = length(data[[1]]), ncol = length(data))
+  return(m)
+})
+
+inputHandlers$set("number", function(val, ...){
+  ifelse(is.null(val), NA, val)
+})
+
+inputHandlers$set("date", function(val, ...){
+  # First replace NULLs with NA, then convert to Date vector
+  datelist <- ifelse(lapply(val, is.null), NA, val)
+  as.Date(unlist(datelist))
+})
+
+
+#' Register an Input Handler
+#' 
+#' Adds an input handler for data of this type. When called, Shiny will use the
+#' function provided to refine the data passed back from the client (after being
+#' deserialized by RJSONIO) before making it available in the \code{input}
+#' variable of the \code{server.R} file. 
+#' 
+#' This function will register the handler for the duration of the R process 
+#' (unless Shiny is explicitly reloaded). For that reason, the \code{type} used
+#' should be very specific to this package to minimize the risk of colliding
+#' with another Shiny package which might use this data type name.
+#' 
+#' The \code{type} of a custom Shiny Input widget will be deduced using the 
+#' \code{getType()} JavaScript function on the registered Shiny inputBinding.
+#' @param type The type for which the handler should be added
+#' @param fun The handler function. This is the function that will be used to
+#'   parse the data delivered from the client before it is available in the 
+#'   \code{input} variable. The function will be called with the following three
+#'   parameters: 
+#'    \enumerate{
+#'      \item{The value of this input as provided by the client, deserialized 
+#'      using RJSONIO.}
+#'      \item{The \code{shinysession} in which the input exists.}
+#'      \item{The name of the input.}
+#'    }
+#' @param force If \code{TRUE}, will overwrite any existing handler without
+#' warning.
+#' @seealso \code{\link{removeInputHandler}}
+#' @export
+addInputHandler <- function(type, fun, force=FALSE){
+  if (inputHandlers$containsKey(type) && !force){
+    stop("There is already an input handler for type: ", type)
+  }
+  inputHandlers$set(type, fun)
+}
+
+#' Deregister an Input Handler
+#' 
+#' Removes an Input Handler. Rather than using the previously specified handler
+#' for data of this type, the default RJSONIO serialization will be used.
+#' 
+#' @param type The type for which handlers should be removed.
+#' @return The handler previously associated with this \code{type}, if one
+#'   existed. Otherwise, \code{NULL}.
+#' @seealso \code{\link{addInputHandler}}
+#' @export
+removeInputHandler <- function(type){
+  inputHandlers$remove(type)
+}
+
+
 # Provide a character representation of the WS that can be used
 # as a key in a Map.
 wsToKey <- function(WS) {
@@ -958,20 +1037,6 @@ decodeMessage <- function(data) {
   return(mainMessage)
 }
 
-# Takes a list-of-lists and returns a matrix. The lists
-# must all be the same length. NULL is replaced by NA.
-unpackMatrix <- function(data) {
-  if (length(data) == 0)
-    return(matrix(nrow=0, ncol=0))
-
-  m <- matrix(unlist(lapply(data, function(x) {
-    sapply(x, function(y) {
-      ifelse(is.null(y), NA, y)
-    })
-  })), nrow = length(data[[1]]), ncol = length(data))
-  return(m)
-}
-
 # Combine dir and (file)name into a file path. If a file already exists with a
 # name differing only by case, then use it instead.
 file.path.ci <- function(dir, name) {
@@ -1116,18 +1181,16 @@ startApp <- function(httpHandlers, serverFuncSource, port, workerId) {
             if (length(splitName) > 1) {
               msg$data[[name]] <- NULL
 
-              # TODO: Make the below a user-extensible registry of deserializers
-              msg$data[[ splitName[[1]] ]] <- switch(
-                splitName[[2]],
-                matrix = unpackMatrix(val),
-                number = ifelse(is.null(val), NA, val),
-                date = {
-                  # First replace NULLs with NA, then convert to Date vector
-                  datelist <- ifelse(lapply(val, is.null), NA, val)
-                  as.Date(unlist(datelist))
-                },
-                stop('Unknown type specified for ', name)
-              )
+              if (!inputHandlers$containsKey(splitName[[2]])){
+                # No input handler registered for this type
+                stop ("Unknown type specified for ", name)
+              }
+
+              msg$data[[ splitName[[1]] ]] <- 
+                  inputHandlers$get(splitName[[2]])(
+                      val, 
+                      shinysession, 
+                      splitName[[1]] )
             }
             else if (is.list(val) && is.null(names(val))) {
               val_flat <- unlist(val, recursive = TRUE)

man/addInputHandler.Rd

@@ -0,0 +1,45 @@
+\name{addInputHandler}
+\alias{addInputHandler}
+\title{Register an Input Handler}
+\usage{
+  addInputHandler(type, fun, force = FALSE)
+}
+\arguments{
+  \item{type}{The type for which the handler should be
+  added}
+
+  \item{fun}{The handler function. This is the function
+  that will be used to parse the data delivered from the
+  client before it is available in the \code{input}
+  variable. The function will be called with the following
+  three parameters: \enumerate{ \item{The value of this
+  input as provided by the client, deserialized using
+  RJSONIO.} \item{The \code{shinysession} in which the
+  input exists.} \item{The name of the input.} }}
+
+  \item{force}{If \code{TRUE}, will overwrite any existing
+  handler without warning.}
+}
+\description{
+  Adds an input handler for data of this type. When called,
+  Shiny will use the function provided to refine the data
+  passed back from the client (after being deserialized by
+  RJSONIO) before making it available in the \code{input}
+  variable of the \code{server.R} file.
+}
+\details{
+  This function will register the handler for the duration
+  of the R process (unless Shiny is explicitly reloaded).
+  For that reason, the \code{type} used should be very
+  specific to this package to minimize the risk of
+  colliding with another Shiny package which might use this
+  data type name.
+
+  The \code{type} of a custom Shiny Input widget will be
+  deduced using the \code{getType()} JavaScript function on
+  the registered Shiny inputBinding.
+}
+\seealso{
+  \code{\link{removeInputHandler}}
+}
+

man/removeInputHandler.Rd

@@ -0,0 +1,23 @@
+\name{removeInputHandler}
+\alias{removeInputHandler}
+\title{Deregister an Input Handler}
+\usage{
+  removeInputHandler(type)
+}
+\arguments{
+  \item{type}{The type for which handlers should be
+  removed.}
+}
+\value{
+  The handler previously associated with this \code{type},
+  if one existed. Otherwise, \code{NULL}.
+}
+\description{
+  Removes an Input Handler. Rather than using the
+  previously specified handler for data of this type, the
+  default RJSONIO serialization will be used.
+}
+\seealso{
+  \code{\link{addInputHandler}}
+}
+