The R Project SVN
R-packages
(root)/trunk/RJSONIO/R/json.R – Rev 7747
Blame | Last modification | View Log | Download | RSS feed
emptyNamedList = structure(list(), names = character())trim =function (x)gsub("(^[[:space:]]+|[[:space:]]+$)", "", x)dQuote =function(x){if(length(x) == 0)character(0)elsepaste('"', x, '"', sep = "")}isContainer =function(x, asIs, .level)(is.na(asIs) && .level == 1) || (!is.na(asIs) && asIs) ||.level == 1L || length(x) > 1 || length(names(x)) > 0 || is.list(x)setGeneric("toJSON",function(x, container = isContainer(x, asIs, .level),collapse = "\n", ...,.level = 1L, .withNames = length(x) > 0 && length(names(x)) > 0,.na = "null", .escapeEscapes = TRUE, pretty = FALSE, asIs = NA, .inf = " Infinity") {container; .withNames # force these values.ans <- standardGeneric("toJSON")if(pretty)jsonPretty(ans)elseans})setMethod("toJSON", "NULL",function(x, container = isContainer(x, asIs, .level), collapse = "\n", ...,.level = 1L, .withNames = length(x) > 0 && length(names(x)) > 0, .na = "null",.escapeEscapes = TRUE, pretty = FALSE, asIs = NA, .inf = " Infinity") {if(container) "[ null ] " else "null"})setMethod("toJSON", "array",function(x, container = isContainer(x, asIs, .level), collapse = "\n", ...,.level = 1L, .withNames = length(x) > 0 && length(names(x)) > 0,.na = "null", .escapeEscapes = TRUE, pretty = FALSE, asIs = NA, .inf = " Infinity") {d = dim(x)txt = apply(x, length(d), toJSON, collapse = collapse, ..., .level = .level + 1L, .withNames = .withNames, .na = .na, .escapeEscapes = .escapeEscapes, pretty = pretty, asIs = asIs, .inf = .inf)paste(c("[", paste(txt, collapse = ", "), "]"), collapse = collapse)})setMethod("toJSON", "function",function(x, container = isContainer(x, asIs, .level), collapse = "\n", ...,.level = 1L, .withNames = length(x) > 0 && length(names(x)) > 0,.na = "null", .escapeEscapes = TRUE, pretty = FALSE, asIs = NA, .inf = " Infinity") {toJSON(paste(deparse(x), collapse = collapse), container, collapse, ..., .level = .level, .withNames = .withNames, .na = .na, .escapeEscapes = .escapeEscapes, pretty = pretty, asIs = asIs, .inf = .inf)})setMethod("toJSON", "ANY",function(x, container = isContainer(x, asIs, .level), collapse = "\n", ...,.level = 1L, .withNames = length(x) > 0 && length(names(x)) > 0,.na = "null", .escapeEscapes = TRUE, pretty = FALSE, asIs = NA, .inf = " Infinity") {if(isS4(x)) {paste("{", paste(dQuote(slotNames(x)), sapply(slotNames(x),function(id)toJSON(slot(x, id), ..., .level = .level + 1L, collapse = collapse,.na = .na, .escapeEscapes = .escapeEscapes, asIs = asIs, pretty = pretty,.inf = .inf)),sep = ": ", collapse = ","),"}", collapse = collapse)} else {#cat(class(x), "\n")if(is.language(x)) {return(toJSON(as.list(x), asIs = asIs, .inf = .inf, .na = .na, pretty = pretty, collapse = collapse, .escapeEscapes = .escapeEscapes))stop("No method for converting ", class(x), " to JSON")}toJSON(unclass(x), container, collapse, ..., .level = .level + 1L,.withNames = .withNames, .na = .na, .escapeEscapes = .escapeEscapes, asIs = asIs)# stop("No method for converting ", class(x), " to JSON")}})setMethod("toJSON", "integer",function(x, container = isContainer(x, asIs, .level),collapse = "\n ", ..., .level = 1L,.withNames = length(x) > 0 && length(names(x)) > 0, .na = "null",.escapeEscapes = TRUE, pretty = FALSE, asIs = NA, .inf = " Infinity"){if(any(is.infinite(x)))warning("non-fininte values in integer vector may not be approriately represented in JSON")if(any(nas <- is.na(x)))x[nas] = .naif(container) {if(.withNames)paste(sprintf("{%s", collapse), paste(dQuote(names(x)), x, sep = ": ", collapse = sprintf(",%s", collapse)), sprintf("%s}", collapse))elsepaste("[", paste(x, collapse = ", "), "]")} elseas.character(x)})setOldClass("hexmode")setMethod("toJSON", "hexmode",function(x, container = isContainer(x, asIs, .level), collapse = "\n ", ...,.level = 1L, .withNames = length(x) > 0 && length(names(x)) > 0,.na = "null", .escapeEscapes = TRUE, pretty = FALSE, asIs = NA, .inf = " Infinity") {tmp = paste("0x", format(x), sep = "")if(any(nas <- is.na(x)))tmp[nas] = .naif(container) {if(.withNames)paste(sprintf("{%s", collapse), paste(dQuote(names(x)), tmp, sep = ": ", collapse = sprintf(",%s", collapse)), sprintf("%s}", collapse))elsepaste("[", paste(tmp, collapse = ", "), "]")} elsetmp})setMethod("toJSON", "factor",function(x, container = isContainer(x, asIs, .level),collapse = "\n", ..., .level = 1L,.withNames = length(x) > 0 && length(names(x)) > 0, .na = "null", pretty = FALSE, asIs = NA, .inf = " Infinity") {toJSON(as.character(x), container, collapse, ..., .level = .level, .na = .na, .escapeEscapes = .escapeEscapes, asIs = asIs, pretty = pretty, .inf = .inf)})setMethod("toJSON", "logical",function(x, container = isContainer(x, asIs, .level),collapse = "\n", ..., .level = 1L,.withNames = length(x) > 0 && length(names(x)) > 0, .na = "null", pretty = FALSE, asIs = NA, .inf = " Infinity") {tmp = ifelse(x, "true", "false")if(any(nas <- is.na(tmp)))tmp[nas] = .naif(container) {if(.withNames)paste(sprintf("{%s", collapse), paste(dQuote(names(x)), tmp, sep = ": ", collapse = sprintf(",%s", collapse)), sprintf("%s}", collapse))elsepaste("[", paste(tmp, collapse = ", "), "]")} elsetmp})setMethod("toJSON", "numeric",function(x, container = isContainer(x, asIs, .level), collapse = "\n", digits = getOption("digits", 5), ...,.level = 1L, .withNames = length(x) > 0 && length(names(x)) > 0,.na = "null", .escapeEscapes = TRUE, pretty = FALSE, asIs = NA,.inf = " Infinity") {if(any(is.infinite(x)))warning("non-fininte values in numeric vector may not be approriately represented in JSON")tmp = formatC(x, digits = digits)if(any(nas <- is.na(x)))tmp[nas] = .naif(any(inf <- is.infinite(x)))tmp[inf] = sprintf(" %s%s", ifelse(x[inf] < 0, "-", ""), .inf)if(container) {if(.withNames)paste(sprintf("{%s", collapse),paste(dQuote(names(x)), tmp, sep = ": ", collapse = sprintf(",%s", collapse)),sprintf("%s}", collapse))elsepaste("[", paste(tmp, collapse = ", "), "]")} elsetmp})setMethod("toJSON", "character",function(x, container = isContainer(x, asIs, .level), collapse = "\n", digits = getOption("digits", 5), ...,.level = 1L, .withNames = length(x) > 0 && length(names(x)) > 0, .na = "null", .escapeEscapes = TRUE, pretty = FALSE, asIs = NA, .inf = " Infinity") {# Don't do this: ! tmp = gsub("\\\n", "\\\\n", x)# if(length(x) == 0) return("[ ]")tmp = xtmp = gsub('(\\\\)', '\\1\\1', tmp)if(.escapeEscapes) {tmp = gsub("\\t", "\\\\t", tmp)tmp = gsub("\\n", "\\\\n", tmp)tmp = gsub("\b", "\\\\b", tmp)tmp = gsub("\\r", "\\\\r", tmp)tmp = gsub("\\f", "\\\\f", tmp)}tmp = gsub('"', '\\\\"', tmp)tmp = dQuote(tmp)if(any(nas <- is.na(x)))tmp[nas] = .naif(container) {if(.withNames)paste(sprintf("{%s", collapse),paste(dQuote(names(x)), tmp, sep = ": ", collapse = sprintf(",%s", collapse)),sprintf("%s}", collapse))elsepaste("[", paste(tmp, collapse = ", "), "]")} else if(length(x) == 0)"[ ]"elsetmp})# Symbols.# names can't be NAsetMethod("toJSON", "name",function(x, container = isContainer(x, asIs, .level), collapse = "\n", ..., .level = 1L, .withNames = length(x) > 0 && length(names(x)) > 0, .na = "null", .escapeEscapes = TRUE, pretty = FALSE, asIs = NA, .inf = " Infinity") {as.character(x)})setMethod("toJSON", "name",function(x, container = isContainer(x, asIs, .level), collapse = "\n", ..., .level = 1L, .withNames = length(x) > 0 && length(names(x)) > 0, .na = "null", .escapeEscapes = TRUE, pretty = FALSE, asIs = NA) {sprintf('"%s"', as.character(x))})setOldClass("AsIs")setMethod("toJSON", "AsIs",function(x, container = isContainer(x, asIs, .level), collapse = "\n", ..., .level = 1L, .withNames = length(x) > 0 && length(names(x)) > 0, .na = "null", .escapeEscapes = TRUE, asIs = NA, .inf = " Infinity") {toJSON(structure(x, class = class(x)[-1]), container = TRUE, collapse = collapse, ..., .level = .level + 1L, .withNames = .withNames, .na = .na, .escapeEscapes = .escapeEscapes, asIs = asIs, .inf = .inf)})setMethod("toJSON", "matrix",function(x, container = isContainer(x, asIs, .level), collapse = "\n", ...,.level = 1L, .withNames = length(x) > 0 && length(names(x)) > 0, .na = "null", .escapeEscapes = TRUE, pretty = FALSE, asIs = NA, .inf = " Infinity"){tmp = paste(apply(x, 1, toJSON, .na = .na, ..., .escapeEscapes = .escapeEscapes, .inf = .inf), collapse = sprintf(",%s", collapse))if(!container)return(tmp)if(.withNames)paste("{", paste(dQuote(names(x)), tmp, sep = ": "), "}")elsepaste("[", tmp, "]")})setMethod("toJSON", "list",function(x, container = isContainer(x, asIs, .level), collapse = "\n", ..., .level = 1L, .withNames = length(x) > 0 && length(names(x)) > 0, .na = "null", .escapeEscapes = TRUE, pretty = FALSE, asIs = NA, .inf = " Infinity") {# Degenerate case.if(length(x) == 0) {# x = structure(list(), names = character()) gives {}return(if(is.null(names(x))) "[]" else "{}")}els = lapply(x, toJSON, ..., .level = .level + 1L, .na = .na, .escapeEscapes = .escapeEscapes, asIs = asIs, .inf = .inf, collapse = collapse)if(all(sapply(els, is.name)))names(els) = NULLif(missing(container) && is.na(asIs))container = TRUEif(!container)return(els)# els = unlist(els)w = sapply(els, length) == 0els[w] = "[]" # or "" or "null"if(.withNames)paste(sprintf("{%s", collapse),paste(dQuote(names(x)), els, sep = ": ", collapse = sprintf(",%s", collapse)),sprintf("%s}", collapse))elsepaste(sprintf("[%s", collapse), paste(els, collapse = sprintf(",%s", collapse)), sprintf("%s]", collapse))})if(TRUE)setMethod("toJSON", "data.frame",function(x, container = isContainer(x, asIs, .level), collapse = "\n", ..., byrow = FALSE, colNames = FALSE, .level = 1L,.withNames = length(x) > 0 && length(names(x)) > 0, .na = "null",.escapeEscapes = TRUE, pretty = FALSE, asIs = NA, .inf = " Infinity"){if(byrow) {tmp = lapply(1:nrow(x), function(i) { row = as.list(x[i, ])if(colNames)rowelseunname(row)})toJSON(tmp, container, collapse, ..., .level = .level, .withNames = FALSE,.na = .na, .escapeEscapes = .escapeEscapes, pretty = pretty, asIs = asIs, .inf = .inf)} else# Data frame columns should always be treated as containers. From Joe ChengtoJSON(lapply(as.list(x),function(col)I(col)),container = container, collapse = collapse, ...,.level = .level, .withNames = .withNames, .na = .na,.escapeEscapes = .escapeEscapes, pretty = pretty, asIs = asIs, .inf = .inf)})jsonPretty =function(txt){txt = paste(as.character(txt), collapse = "\n")enc = mapEncoding(Encoding(txt)).Call("R_jsonPrettyPrint", txt, enc, PACKAGE = "RJSONIO")}setMethod("toJSON", "environment",function(x, container = isContainer(x, asIs, .level), collapse = "\n ", ...,.level = 1L, .withNames = length(x) > 0 && length(names(x)) > 0, .na = "null",.escapeEscapes = TRUE, pretty = FALSE, asIs = NA, .inf = " Infinity") {toJSON(as.list(x), container, collapse, .level = .level, .withNames = .withNames, .escapeEscapes = .escapeEscapes, asIs = asIs, .inf = .inf)})setMethod("toJSON", "function",function(x, container = isContainer(x, asIs, .level), collapse = "\n ", ...,.level = 1L, .withNames = length(x) > 0 && length(names(x)) > 0, .na = "null",.escapeEscapes = TRUE, pretty = FALSE, asIs = NA, .inf = " Infinity") {warning("converting an R function to JSON as null. To change this, define a method for toJSON() for a 'function' object.")"null"})