refactoring

R/asJSON.AAAgeneric.R

@@ -1,7 +1,3 @@
-setGeneric("asJSON", function(x, pretty = FALSE, ...) {
-  ans <- standardGeneric("asJSON")
-  if (isTRUE(pretty)) {
-    ans <- prettify(ans)
-  }
-  return(ans)
+setGeneric("asJSON", function(x, ...) {
+  standardGeneric("asJSON")
 }) 

R/asJSON.ANY.R

@@ -3,7 +3,7 @@ setMethod("asJSON", "ANY", function(x, force = FALSE, ...) {
     if (isTRUE(force)) {
       return(asJSON(attributes(x), ...))
     } else {
-      stop("No S4 method for object of class:", class(x))
+      stop("No method for S4 class:", class(x))
     }
   } else if (length(class(x)) > 1) {
     # If an object has multiple classes, we recursively try the next class. This is
@@ -15,6 +15,6 @@ setMethod("asJSON", "ANY", function(x, force = FALSE, ...) {
     return(asJSON(unclass(x), ...))
   } else {
     # If even that doesn't work, we give up.
-    stop("No S3 method asJSON for class: ", class(x))
+    stop("No method asJSON S3 class: ", class(x))
   }
 }) 

R/asJSON.Date.R

@@ -4,7 +4,12 @@ setMethod("asJSON", "Date", function(x, Date = c("ISO8601", "epoch"), ...) {
   Date <- match.arg(Date)
 
   # select a schema
-  output <- switch(Date, ISO8601 = as.iso(x), epoch = unclass(x), default = stop("Invalid argument for 'Date':", 
-    Date))
-  return(asJSON(output, ...))
+  output <- switch(Date, 
+    ISO8601 = as.iso(x), 
+    epoch = unclass(x), 
+    default = stop("Invalid argument for 'Date':", Date)
+  )
+
+  # Dispatch to character encoding
+  asJSON(output, ...)
 }) 

R/asJSON.POSIXt.R

@@ -17,9 +17,11 @@ setMethod("asJSON", "POSIXt", function(x, POSIXt = c("string", "ISO8601", "epoch
       x <- as.POSIXct(x)
     }
     y <- lapply(as.list(x), function(item) {
-      if (is.na(item)) 
-        return(item)
-      as.scalar(list(`$date` = as.scalar(floor((unclass(item) * 1000)))))
+      if (is.na(item)) {
+        item
+      } else {
+        as.scalar(list(`$date` = as.scalar(floor(unclass(item) * 1000))))
+      }      
     })
     return(asJSON(y, digits = 0, ...))
   } else if (POSIXt == "ISO8601") {

R/asJSON.character.R

@@ -1,8 +1,9 @@
-setMethod("asJSON", "character", function(x, container = TRUE, na = c("default", 
-  "null", "string"), ...) {
+setMethod("asJSON", "character", function(x, collapse = TRUE, na = c("default", 
+  "null", "string", "NA"), ...) {
   # 0 vector is not handled properly by paste()
-  if (!length(x)) 
+  if (!length(x)) {
     return("[]")
+  }
 
   # vectorized escaping
   tmp <- deparse_vector(x)
@@ -11,18 +12,14 @@ setMethod("asJSON", "character", function(x, container = TRUE, na = c("default",
   na <- match.arg(na)
   if (na %in% c("default", "null")) {
     tmp[is.na(x)] <- "null"
-  } else {
+  } else if(na %in% "string") {
     tmp[is.na(x)] <- "\"NA\""
   }
 
-  # collapse
-  tmp <- paste(tmp, collapse = ", ")
-
   # this is almost always true, except for class 'scalar'
-  if (container) {
-    tmp <- paste("[", tmp, "]")
+  if (isTRUE(collapse)) {
+    collapse(tmp)
+  } else {
+    tmp
   }
-
-  # return
-  return(tmp)
 }) 

R/asJSON.complex.R

@@ -1,28 +1,31 @@
-setMethod("asJSON", "complex", function(x, digits = 5, container = TRUE, complex = c("string", 
-  "list"), na = "string", ...) {
+setMethod("asJSON", "complex", function(x, digits = 5, collapse = TRUE, complex = c("string", 
+  "list"), na = c("string", "null", "NA", "default"), ...) {
+
   # validate
+  na <- match.arg(na);
   complex <- match.arg(complex)
 
   # empty vector
-  if (!length(x)) 
+  if (!length(x)) {
     return("[]")
+  }
 
+  #turn into strings
   if (complex == "string") {
+    #default NA is "NA"
     mystring <- prettyNum(x = x, digits = digits)
-    if (na == "null") {
-      mystring[is.na(x)] <- NA
-    }
-
-    if (!container) {
-      mystring <- as.scalar(mystring)
+    if (any(missings <- which(!is.finite(x)))){
+      if (na %in% c("null", "NA")) {
+        mystring[missings] <- NA;
+      }
     }
-    return(asJSON(mystring, na = "null", ...))
+    return(asJSON(mystring, collapse = collapse, na = na, ...))
   } else {
     mylist <- list(real = Re(x), imaginary = Im(x))
 
-    # this is a bit of a hack if container is false, this is length 1 vector so we
+    # this is a bit of a hack if collapse is false, this is length 1 vector so we
     # have to actually apply this so the real and imaginary elements of the list
-    if (!container) {
+    if (!collapse) {
       mylist <- lapply(mylist, as.scalar)
     }
 

R/asJSON.data.frame.R

@@ -1,5 +1,5 @@
 setMethod("asJSON", "data.frame", function(x, na = c("default", "null", "string"), 
-  container = TRUE, dataframe = c("rows", "columns"), raw, ...) {
+  collapse = TRUE, dataframe = c("rows", "columns"), raw, ...) {
   # Note: just as in asJSON.list we take the container argument to prevent it form
   # being passed down through ... This is needed in the rare case that a dataframe
   # contains new dataframes, and hence as.scalar is inappropriate check how we want
@@ -13,7 +13,7 @@ setMethod("asJSON", "data.frame", function(x, na = c("default", "null", "string"
   }
 
   if (dataframe == "columns") {
-    return(asJSON(as.list(x), na = na, container = container, dataframe = "columns", 
+    return(asJSON(as.list(x), na = na, collapse = collapse, dataframe = "columns", 
       raw = "hex", ...))
   }
 
@@ -48,7 +48,7 @@ setMethod("asJSON", "data.frame", function(x, na = c("default", "null", "string"
   }
 
   # we assume a dataframe with one row
-  if (!isTRUE(container)) {
+  if (!isTRUE(collapse)) {
     if (length(out) == 1) {
       out <- out[[1]]
     } else {

R/asJSON.factor.R

@@ -5,9 +5,9 @@ setMethod("asJSON", "factor", function(x, factor = c("string", "integer"), ...)
   # dispatch
   if (factor == "integer") {
     # encode factor as enum
-    return(asJSON(unclass(x), ...))
+    asJSON(unclass(x), ...)
   } else {
     # encode as strings
-    return(asJSON(as.character(x), ...))
+    asJSON(as.character(x), ...)
   }
-}) 
+})

R/asJSON.function.R

@@ -1,4 +1,4 @@
-setMethod("asJSON", "function", function(x, container = TRUE, fun = c("source", "list"), 
+setMethod("asJSON", "function", function(x, collapse = TRUE, fun = c("source", "list"), 
   ...) {
   # validate
   fun <- match.arg(fun)

R/asJSON.list.R

@@ -1,4 +1,4 @@
-setMethod("asJSON", "list", function(x, container = TRUE, ...) {
+setMethod("asJSON", "list", function(x, collapse = TRUE, ...) {
 
   # We are explicitly taking the container argument to prevent it from being passed
   # down through ... (elipse) As scalar should never be applied to an entire list
@@ -16,25 +16,31 @@ setMethod("asJSON", "list", function(x, container = TRUE, ...) {
 
   # this condition appears when a dataframe contains a column with lists we need to
   # do this, because the [ operator always returns a list of length 1
-  if (length(x) == 1 && is.null(names(x)) && container == FALSE) {
+  if (length(x) == 1 && is.null(names(x)) && collapse == FALSE) {
     return(asJSON(x[[1]], ...))
   }
 
   # note we are NOT passing on the container argument.
-  els <- vapply(x, asJSON, character(1), ...)
+  tmp <- vapply(x, asJSON, character(1), ...)
 
-  if (all(sapply(els, is.name))) {
-    names(els) <- NULL
+  # this seems redundant??
+  if (all(sapply(tmp, is.name))) {
+    names(tmp) <- NULL
   }
 
   if (length(names(x))) {
+    #in case of named list:    
     objnames <- names(x)
-    objnames[objnames == ""] <- as.character(1:length(objnames))[objnames == 
-      ""]
+    objnames[objnames == ""] <- as.character(1:length(objnames))[objnames == ""]
     objnames <- make.unique(objnames)
-    return(paste("{", paste(deparse_vector(objnames), els, sep = " : ", collapse = ", "), 
-      "}"))
+    paste("{", paste(deparse_vector(objnames), tmp, sep = " : ", collapse = ", "), "}")
   } else {
-    return(paste("[", paste(els, collapse = ","), "]"))
+    #in case of unnamed list:
+    if(collapse){
+      #collapse(tmp)
+      paste("[", paste0(tmp, collapse = ","), "]")
+    } else {
+      tmp
+    }
   }
 }) 

R/asJSON.logical.R

@@ -1,4 +1,7 @@
-setMethod("asJSON", "logical", function(x, container = TRUE, na = "null", ...) {
+setMethod("asJSON", "logical", function(x, collapse = TRUE, na = c("null", "string", "NA", "default"), ...) {
+  # validate arg
+  na <- match.arg(na)
+
   # empty vector
   if (!length(x)){
     return("[]")
@@ -7,15 +10,18 @@ setMethod("asJSON", "logical", function(x, container = TRUE, na = "null", ...) {
   # json true/false
   tmp <- ifelse(x, "true", "false")
 
-  # logical values can have NA (but not Inf/NaN). Default is to encode as null.
-  if (any(missings <- is.na(x))) {
-    tmp[missings] <- ifelse(identical(na, "string"), "\"NA\"", "null")
+  # replace missing values, unless na="NA"
+  if(!identical(na, "NA")){
+    # logical values can have NA (but not Inf/NaN). Default is to encode as null.
+    if (any(missings <- which(is.na(x)))) {
+      tmp[missings] <- ifelse(identical(na, "string"), "\"NA\"", "null")
+    }
   }
 
-  # wrap in container
-  if (container) {
-    return(paste("[", paste(tmp, collapse = ", "), "]"))
+  # collapse it
+  if(collapse) {
+    collapse(tmp)
   } else {
-    return(tmp)
+    tmp
   }
 }) 

R/asJSON.matrix.R

@@ -1,15 +1,14 @@
 # NOTE: opencpu.encode is never upposed to use this function, because it
 # unclasses every object first.  it is included for completeness.
 
-setMethod("asJSON", "matrix", function(x, container = TRUE, ...) {
+setMethod("asJSON", "matrix", function(x, collapse = TRUE, ...) {
   # row based json
-  tmp <- paste(apply(x, 1, asJSON, ...), collapse = ", ")
+  tmp <- apply(x, 1, asJSON, ...)
 
-  # wrap in container
-  if (container) {
-    tmp <- paste("[", tmp, "]")
+  # collapse it
+  if (collapse) {
+    collapse(tmp)
+  } else {
+    tmp
   }
-
-  # return
-  return(tmp)
 }) 

R/asJSON.numeric.R

@@ -1,4 +1,4 @@
-setMethod("asJSON", "numeric", function(x, container = TRUE, digits = 5, na = "string", 
+setMethod("asJSON", "numeric", function(x, collapse = TRUE, digits = 5, na = "string", 
   ...) {
   # empty vector
   if (!length(x)) {
@@ -12,14 +12,16 @@ setMethod("asJSON", "numeric", function(x, container = TRUE, digits = 5, na = "s
   if (any(missings <- which(!is.finite(x)))) {
     if (na %in% c("default", "string")) {
       tmp[missings] <- wrapinquotes(x[missings])
-    } else {
+    } else if(identical(na, "null")) {
       tmp[missings] <- "null"
+    } else {
+      tmp[missings] <- NA
     }
   }
 
-  if(!container){
-    return(paste0(tmp, collapse = ", "))
+  if(collapse){
+    collapse(tmp)
   } else {
-    return(paste0("[ ", paste0(tmp, collapse = ", "), " ]"))
+    tmp
   }
 }) 

R/asJSON.scalar.R

@@ -8,5 +8,5 @@ setMethod("asJSON", "scalar", function(x, ...) {
   }
 
   # Print JSON without []
-  return(asJSON(x, container = FALSE, ...))
+  return(asJSON(x, collapse = FALSE, ...))
 }) 

R/collapse.R

@@ -0,0 +1,3 @@
+collapse <- function(x){
+  paste("[", paste0(x, collapse = ", "), "]")
+}

R/toJSON.R

@@ -18,9 +18,15 @@ toJSON <- function(x, dataframe = c("rows", "columns"), Date = c("ISO8601", "epo
   x <- force(x)
 
   # dispatch
-  asJSON(x, dataframe = dataframe, Date = Date, POSIXt = POSIXt, factor = factor, 
-    complex = complex, raw = raw, digits = digits, na = na, pretty = pretty, 
-    ...)
+  ans <- asJSON(x, dataframe = dataframe, Date = Date, POSIXt = POSIXt, factor = factor, 
+    complex = complex, raw = raw, digits = digits, na = na, ...)
+
+  #prettify
+  if (isTRUE(pretty)) {
+    return(prettify(ans))
+  } else {
+    return(ans)
+  }
 }
 
 # maps encoding name to integer