Consolidate swagger type information (#388)

* Check the length of re in dynamic path

* Support chr type in the path. Use default string for missing type in the dynamic path

Partially solve # 352

* Add test for chr

* revamp plumber types to use a single source of truth

* use local for helper method

* clean up how swaggerInfo is handled in createPathRegex

* clean up typeToRegexps

* make it clear that `types` is a vector

* use a warning instead of a stop call when an unknown plumber type is found.

* fix test

* make sure the unknown plumber type returns 'string'

* news item

NEWS.md

@@ -32,6 +32,8 @@ plumber 0.5.0
 
 ### Minor new features and improvements
 
+* Added new shorthand types for url parameters. (@byzheng, [#388](https://github.com/trestletech/plumber/pull/388))
+
 * Changed Swagger UI to use [swagger](https://github.com/rstudio/swagger) R package to display the
     swagger page. ([#365](https://github.com/trestletech/plumber/pull/365))
 

R/plumber-step.R

@@ -125,7 +125,7 @@ PlumberEndpoint <- R6Class(
     comments = NA,
     responses = NA,
     getTypedParams = function(){
-      data.frame(name=private$regex$names, type=private$regex$types)
+      data.frame(name=private$regex$names, type=private$regex$types, stringsAsFactors = FALSE)
     },
     params = NA,
     tags = NA,

R/query-string.R

@@ -58,55 +58,65 @@ parseQS <- function(qs){
 
 createPathRegex <- function(pathDef){
   # Create a regex from the defined path, substituting variables where appropriate
-  match <- stringi::stri_match_all(pathDef, regex="/<(\\.?[a-zA-Z][\\w_\\.]*)(:(int|double|numeric|bool|logical))?>")[[1]]
+  match <- stringi::stri_match_all(
+    pathDef,
+    # capture any plumber type (<arg:TYPE>) (typesToRegexps(type) will yell if it is unknown)
+    # <arg> will be given the TYPE `defaultSwaggerType`
+    regex = "/<(\\.?[a-zA-Z][\\w_\\.]*)(:([^>]*))?>"
+  )[[1]]
   names <- match[,2]
-  type <- match[,4]
+  types <- match[,4]
   if (length(names) <= 1 && is.na(names)){
-    names <- character()
-    type <- NULL
+    return(
+      list(
+        names = character(),
+        types = NULL,
+        regex = paste0("^", pathDef, "$"),
+        converters = NULL
+      )
+    )
   }
-
-  typedRe <- typeToRegex(type)
-  re <- pathDef
-  for (r in typedRe){
-    repl <- paste0("/(", r, ")$2")
-    re <- stringi::stri_replace_first_regex(re, pattern="/(<\\.?[a-zA-Z][\\w_\\.:]*>)(/?)",
-                                          replacement=repl)
+  if (length(types) > 0) {
+    types[is.na(types)] <- defaultSwaggerType
   }
 
-  converters <- typeToConverters(type)
+  pathRegex <- pathDef
+  regexps <- typesToRegexps(types)
+  for (regex in regexps) {
+    pathRegex <- stringi::stri_replace_first_regex(
+      pathRegex,
+      pattern = "/(<\\.?[a-zA-Z][\\w_\\.:]*>)(/?)",
+      replacement = paste0("/(", regex, ")$2")
+    )
+  }
 
-  list(names = names, types=type, regex = paste0("^", re, "$"), converters=converters)
+  list(
+    names = names,
+    types = types,
+    regex = paste0("^", pathRegex, "$"),
+    converters = typeToConverters(types)
+  )
 }
 
-typeToRegex <- function(type){
-  re <- rep("[^/]+", length(type))
-  re[type == "int"] <- "-?\\\\d+"
-  re[type == "double" | type == "numeric"] <- "-?\\\\d*\\\\.?\\\\d+"
-  re[type == "bool" | type == "logical"] <- "[01tfTF]|true|false|TRUE|FALSE"
 
-  re
+typesToRegexps <- function(types) {
+  # return vector of regex strings
+  vapply(
+    swaggerTypeInfo[plumberToSwaggerType(types)],
+    `[[`, character(1), "regex"
+  )
 }
 
-typeToConverters <- function(type){
-  re <- NULL
-  for (t in type){
-    r <- function(x){x}
-
-    if (!is.na(t)){
-      if (t == "int"){
-        r <- as.integer
-      } else if (t == "double" || t == "numeric"){
-        r <- as.numeric
-      } else if (t == "bool" || t == "logical"){
-        r <- as.logical
-      }
-    }
-    re <- c(re, r)
-  }
-  re
+
+typeToConverters <- function(types) {
+  # return list of functions
+  lapply(
+    swaggerTypeInfo[plumberToSwaggerType(types)],
+    `[[`, "converter"
+  )
 }
 
+
 # Extract the params from a given path
 # @param def is the output from createPathRegex
 extractPathParams <- function(def, path){

R/swagger.R

@@ -1,20 +1,76 @@
-#' Parse the given plumber type and return the typecast value
-#' @noRd
-plumberToSwaggerType <- function(type){
-  switch(as.character(type),
 
-    "bool" = ,
-    "logical" = "boolean",
 
-    "double" = ,
-    "numeric" = "number",
+# calculate all swagger type information at once and use created information throughout package
+swaggerTypeInfo <- list()
+plumberToSwaggerTypeMap <- list()
+defaultSwaggerType <- "string"
+
+local({
+  addSwaggerInfo <- function(swaggerType, plumberTypes, regex, converter) {
+    swaggerTypeInfo[[swaggerType]] <<-
+      list(
+        regex = regex,
+        converter = converter
+      )
+
 
-    "int" = "integer",
+    for (plumberType in plumberTypes) {
+      plumberToSwaggerTypeMap[[plumberType]] <<- swaggerType
+    }
+    # make sure it could be called again
+    plumberToSwaggerTypeMap[[swaggerType]] <<- swaggerType
 
-    "character" = "string",
+    invisible(TRUE)
+  }
 
-    stop("Unrecognized type: ", type)
+  addSwaggerInfo(
+    "boolean",
+    c("bool", "boolean", "logical"),
+    "[01tfTF]|true|false|TRUE|FALSE",
+    as.logical
+  )
+  addSwaggerInfo(
+    "number",
+    c("dbl", "double", "float", "number", "numeric"),
+    "-?\\\\d*\\\\.?\\\\d+",
+    as.numeric
+  )
+  addSwaggerInfo(
+    "integer",
+    c("int", "integer"),
+    "-?\\\\d+",
+    as.integer
+  )
+  addSwaggerInfo(
+    "string",
+    c("chr", "str", "character", "string"),
+    "[^/]+",
+    as.character
   )
+})
+
+
+#' Parse the given plumber type and return the typecast value
+#' @noRd
+plumberToSwaggerType <- function(type) {
+  if (length(type) > 1) {
+    return(vapply(type, plumberToSwaggerType, character(1)))
+  }
+  # default type is "string" type
+  if (is.na(type)) {
+    return(defaultSwaggerType)
+  }
+
+  swaggerType <- plumberToSwaggerTypeMap[[as.character(type)]]
+  if (is.null(swaggerType)) {
+    warning(
+      "Unrecognized type: ", type, ". Using type: ", defaultSwaggerType,
+      call. = FALSE
+    )
+    swaggerType <- defaultSwaggerType
+  }
+
+  return(swaggerType)
 }
 
 #' Convert the endpoints as they exist on the router to a list which can
@@ -82,7 +138,7 @@ extractSwaggerParams <- function(endpointParams, pathParams){
       if (location == "path") {
         type <- plumberToSwaggerType(pathParams$type[pathParams$name == p])
       } else {
-        type <- "string" # Default to string
+        type <- defaultSwaggerType
       }
     }
 

tests/testthat/test-path-subst.R

@@ -39,6 +39,12 @@ test_that("variables are typed", {
   p <- createPathRegex("/car/<id:logical>")
   expect_equal(p$names, "id")
   expect_equal(p$regex, paste0("^/car/", "([01tfTF]|true|false|TRUE|FALSE)", "$"))
+  p <- createPathRegex("/car/<id:chr>")
+  expect_equal(p$names, "id")
+  expect_equal(p$regex, paste0("^/car/", "([^/]+)", "$"))
+
+
+
 })
 
 test_that("path regex's are created properly", {

tests/testthat/test-swagger.R

@@ -11,7 +11,9 @@ test_that("plumberToSwaggerType works", {
 
   expect_equal(plumberToSwaggerType("character"), "string")
 
-  expect_error(plumberToSwaggerType("flargdarg"), "Unrecognized type:")
+  expect_warning({
+    expect_equal(plumberToSwaggerType("flargdarg"), "string")
+  }, "Unrecognized type:")
 })
 
 test_that("response attributes are parsed", {