├── .Rbuildignore ├── .gitattributes ├── .github ├── .gitignore └── workflows │ ├── R-CMD-check.yaml │ └── rhub.yaml ├── .gitignore ├── CODE_OF_CONDUCT.md ├── COPYING ├── DESCRIPTION ├── LICENSE ├── NAMESPACE ├── NEWS ├── R ├── apply_by_pages.R ├── as.scalar.R ├── asJSON.AAAgeneric.R ├── asJSON.ANY.R ├── asJSON.AsIs.R ├── asJSON.Date.R ├── asJSON.ITime.R ├── asJSON.NULL.R ├── asJSON.POSIXt.R ├── asJSON.array.R ├── asJSON.character.R ├── asJSON.classRepresentation.R ├── asJSON.complex.R ├── asJSON.data.frame.R ├── asJSON.difftime.R ├── asJSON.factor.R ├── asJSON.function.R ├── asJSON.int64.R ├── asJSON.json.R ├── asJSON.list.R ├── asJSON.logical.R ├── asJSON.numeric.R ├── asJSON.pairlist.R ├── asJSON.raw.R ├── asJSON.scalar.R ├── asJSON.sf.R ├── asJSON.vctrs.R ├── base64.R ├── cleannames.R ├── collapse.R ├── collapse_object.R ├── deparse_vector.R ├── fixNativeSymbol.R ├── flatten.R ├── fromJSON.R ├── helpfunctions.R ├── is.recordlist.R ├── is.scalarlist.R ├── json_gzip.R ├── list_to_vec.R ├── loadpkg.R ├── makesymbol.R ├── null_to_na.R ├── num_to_char.R ├── pack.R ├── parseJSON.R ├── prettify.R ├── print.R ├── push_parser.R ├── raw_to_json.R ├── rbind_pages.R ├── read_json.R ├── serializeJSON.R ├── simplify.R ├── simplifyDataFrame.R ├── stop.R ├── stream.R ├── toJSON.R ├── transpose_list.R ├── unbox.R ├── unescape_unicode.R ├── utf8conv.R ├── validate.R └── warn_keep_vec_names.R ├── README.md ├── air.toml ├── inst └── CITATION ├── jsonlite.Rproj ├── man ├── base64.Rd ├── flatten.Rd ├── fromJSON.Rd ├── gzjson.Rd ├── prettify.Rd ├── rbind_pages.Rd ├── read_json.Rd ├── serializeJSON.Rd ├── stream_in.Rd ├── unbox.Rd └── validate.Rd ├── paper ├── article.R ├── article.Rnw ├── article.pdf ├── jss.bst ├── jss.cls ├── jss.dtx └── jsslogo.jpg ├── src ├── Makevars ├── base64.c ├── base64.h ├── collapse_array.c ├── collapse_object.c ├── collapse_pretty.c ├── escape_chars.c ├── integer64_to_na.c ├── is_datelist.c ├── is_recordlist.c ├── is_scalarlist.c ├── modp_numtoa.c ├── modp_numtoa.h ├── null_to_na.c ├── num_to_char.c ├── parse.c ├── prettify.c ├── push_parser.c ├── push_parser.h ├── r-base64.c ├── register.c ├── row_collapse.c ├── transpose_list.c ├── validate.c └── yajl │ ├── api │ ├── yajl_common.h │ ├── yajl_gen.h │ ├── yajl_parse.h │ ├── yajl_tree.h │ └── yajl_version.h │ ├── readme.txt │ ├── yajl.c │ ├── yajl_alloc.c │ ├── yajl_alloc.h │ ├── yajl_buf.c │ ├── yajl_buf.h │ ├── yajl_bytestack.h │ ├── yajl_encode.c │ ├── yajl_encode.h │ ├── yajl_gen.c │ ├── yajl_lex.c │ ├── yajl_lex.h │ ├── yajl_parser.c │ ├── yajl_parser.h │ ├── yajl_tree.c │ └── yajl_version.c ├── tests ├── testthat.R └── testthat │ ├── flatten.R │ ├── helper-toJSON.R │ ├── issues.txt │ ├── readme.txt │ ├── test-fromJSON-NA-values.R │ ├── test-fromJSON-array.R │ ├── test-fromJSON-dataframe.R │ ├── test-fromJSON-datasets.R │ ├── test-fromJSON-date.R │ ├── test-fromJSON-matrix.R │ ├── test-libjson-escaping.R │ ├── test-libjson-large.R │ ├── test-libjson-utf8.R │ ├── test-libjson-validator.R │ ├── test-network-Github.R │ ├── test-serializeJSON-S4.R │ ├── test-serializeJSON-datasets.R │ ├── test-serializeJSON-functions.R │ ├── test-serializeJSON-types.R │ ├── test-toJSON-AsIs.R │ ├── test-toJSON-Date.R │ ├── test-toJSON-NA-values.R │ ├── test-toJSON-NULL-values.R │ ├── test-toJSON-POSIXt.R │ ├── test-toJSON-complex.R │ ├── test-toJSON-dataframe.R │ ├── test-toJSON-factor.R │ ├── test-toJSON-indent.R │ ├── test-toJSON-keep-vec-names.R │ ├── test-toJSON-logical.R │ ├── test-toJSON-matrix.R │ ├── test-toJSON-numeric.R │ ├── test-toJSON-raw.R │ ├── test-toJSON-sf.R │ ├── test-toJSON-zerovec.R │ └── test_rbind_pages.R └── vignettes ├── json-aaquickstart.Rmd ├── json-apis.Rmd ├── json-apis.Rmd.orig ├── json-mapping.Rnw.orig ├── json-mapping.pdf ├── json-mapping.pdf.asis ├── json-opencpu.Rnw.orig ├── json-opencpu.pdf ├── json-opencpu.pdf.asis ├── json-paging.Rmd ├── json-paging.Rmd.orig ├── precompile.R └── references.bib /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^Meta$ 2 | ^doc$ 3 | .Rproj.user$ 4 | .Rhistory$ 5 | .RData$ 6 | .*.bbl$ 7 | .*.blg$ 8 | .*.aux$ 9 | .*.out$ 10 | .*.log$ 11 | .*.o$ 12 | .*.a$ 13 | .*.so$ 14 | ^.*\.Rproj$ 15 | ^\.Rproj\.user$ 16 | vignettes/*.tex$ 17 | vignettes/*.log$ 18 | vignettes/*.gz$ 19 | vignettes/*.aux$ 20 | vignettes/*.bbl$ 21 | vignettes/*.pdf$ 22 | vignettes/framed.sty$ 23 | ^README.md$ 24 | ^tidy.R$ 25 | ^.travis.yml$ 26 | ^paper$ 27 | ^stuff$ 28 | ^copying$ 29 | ^docs$ 30 | ^appveyor.yml$ 31 | ^revdep$ 32 | ^CODE_OF_CONDUCT\.md$ 33 | ^\.github$ 34 | ^air.toml$ 35 | 36 | -------------------------------------------------------------------------------- /.gitattributes: -------------------------------------------------------------------------------- 1 | *.html linguist-documentation=true 2 | -------------------------------------------------------------------------------- /.github/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | -------------------------------------------------------------------------------- /.github/workflows/R-CMD-check.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/master/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | pull_request: 6 | 7 | name: R-CMD-check 8 | 9 | jobs: 10 | R-CMD-check: 11 | runs-on: ${{ matrix.config.os }} 12 | 13 | name: ${{ matrix.config.os }} (${{ matrix.config.r }}) 14 | 15 | strategy: 16 | fail-fast: false 17 | matrix: 18 | config: 19 | - {os: macOS-latest, r: 'release'} 20 | - {os: macOS-15, r: 'next'} 21 | - {os: windows-2022, r: 'devel'} 22 | - {os: windows-latest, r: '4.1'} 23 | - {os: windows-latest, r: '3.6'} 24 | - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'} 25 | - {os: ubuntu-latest, r: 'release'} 26 | - {os: ubuntu-latest, r: 'oldrel-1'} 27 | - {os: ubuntu-latest, r: 'oldrel-2'} 28 | - {os: ubuntu-latest, r: 'oldrel-3'} 29 | - {os: ubuntu-latest, r: 'oldrel-4'} 30 | 31 | env: 32 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 33 | R_KEEP_PKG_SOURCE: yes 34 | 35 | steps: 36 | - uses: actions/checkout@v4 37 | 38 | - uses: r-lib/actions/setup-pandoc@v2 39 | 40 | - uses: r-lib/actions/setup-r@v2 41 | with: 42 | r-version: ${{ matrix.config.r }} 43 | http-user-agent: ${{ matrix.config.http-user-agent }} 44 | use-public-rspm: true 45 | 46 | - uses: r-lib/actions/setup-r-dependencies@v2 47 | with: 48 | extra-packages: rcmdcheck 49 | 50 | - uses: r-lib/actions/check-r-package@v2 51 | env: 52 | MAKEFLAGS: -j4 53 | -------------------------------------------------------------------------------- /.github/workflows/rhub.yaml: -------------------------------------------------------------------------------- 1 | # R-hub's genetic GitHub Actions workflow file. It's canonical location is at 2 | # https://github.com/r-hub/rhub2/blob/v1/inst/workflow/rhub.yaml 3 | # You can update this file to a newer version using the rhub2 package: 4 | # 5 | # rhub2::rhub_setup() 6 | # 7 | # It is unlikely that you need to modify this file manually. 8 | 9 | name: R-hub 10 | run-name: ${{ github.event.inputs.name || format('Manually run by {0}', github.triggering_actor) }} (${{ github.event.inputs.id }}) 11 | 12 | on: 13 | workflow_dispatch: 14 | inputs: 15 | config: 16 | description: 'A comma separated list of R-hub platforms to use.' 17 | type: string 18 | default: 'linux,windows,macos' 19 | name: 20 | description: 'Run name. You can leave this empty now.' 21 | type: string 22 | id: 23 | description: 'Unique ID. You can leave this empty now.' 24 | type: string 25 | 26 | jobs: 27 | 28 | setup: 29 | runs-on: ubuntu-latest 30 | outputs: 31 | containers: ${{ steps.rhub-setup.outputs.containers }} 32 | platforms: ${{ steps.rhub-setup.outputs.platforms }} 33 | 34 | steps: 35 | # NO NEED TO CHECKOUT HERE 36 | - uses: r-hub/rhub2/actions/rhub-setup@v1 37 | with: 38 | config: ${{ github.event.inputs.config }} 39 | id: rhub-setup 40 | 41 | linux-containers: 42 | needs: setup 43 | if: ${{ needs.setup.outputs.containers != '[]' }} 44 | runs-on: ubuntu-latest 45 | name: ${{ matrix.config.label }} 46 | strategy: 47 | fail-fast: false 48 | matrix: 49 | config: ${{ fromJson(needs.setup.outputs.containers) }} 50 | container: 51 | image: ${{ matrix.config.container }} 52 | 53 | steps: 54 | - uses: actions/checkout@v3 55 | - uses: r-hub/rhub2/actions/rhub-check@v1 56 | with: 57 | token: ${{ secrets.RHUB_TOKEN }} 58 | job-config: ${{ matrix.config.job-config }} 59 | 60 | other-platforms: 61 | needs: setup 62 | if: ${{ needs.setup.outputs.platforms != '[]' }} 63 | runs-on: ${{ matrix.config.os }} 64 | name: ${{ matrix.config.label }} 65 | strategy: 66 | fail-fast: false 67 | matrix: 68 | config: ${{ fromJson(needs.setup.outputs.platforms) }} 69 | 70 | steps: 71 | - uses: actions/checkout@v3 72 | - uses: r-hub/rhub2/actions/rhub-setup-r@v1 73 | with: 74 | job-config: ${{ matrix.config.job-config }} 75 | token: ${{ secrets.RHUB_TOKEN }} 76 | - uses: r-hub/rhub2/actions/rhub-check@v1 77 | with: 78 | job-config: ${{ matrix.config.job-config }} 79 | token: ${{ secrets.RHUB_TOKEN }} 80 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | Meta 2 | doc 3 | .Rproj.user 4 | .Rhistory 5 | .RData 6 | config.status 7 | config.log 8 | *.o 9 | *.so 10 | *.dll 11 | *.cpp 12 | *.a 13 | paper/*.gz 14 | paper/*.log 15 | paper/*.tex 16 | paper/*concordance.tex 17 | paper/*.bbl 18 | vignettes/*.tex 19 | vignettes/*.log 20 | vignettes/*.gz 21 | vignettes/*.aux 22 | vignettes/*.bbl 23 | man/as.scalar.Rd 24 | vignettes/framed.sty 25 | vignettes/.DS_Store 26 | .DS_Store 27 | 28 | -------------------------------------------------------------------------------- /CODE_OF_CONDUCT.md: -------------------------------------------------------------------------------- 1 | # Contributor Code of Conduct 2 | 3 | As contributors and maintainers of this project, we pledge to respect all people who 4 | contribute through reporting issues, posting feature requests, updating documentation, 5 | submitting pull requests or patches, and other activities. 6 | 7 | We are committed to making participation in this project a harassment-free experience for 8 | everyone, regardless of level of experience, gender, gender identity and expression, 9 | sexual orientation, disability, personal appearance, body size, race, ethnicity, age, or religion. 10 | 11 | Examples of unacceptable behavior by participants include the use of sexual language or 12 | imagery, derogatory comments or personal attacks, trolling, public or private harassment, 13 | insults, or other unprofessional conduct. 14 | 15 | Project maintainers have the right and responsibility to remove, edit, or reject comments, 16 | commits, code, wiki edits, issues, and other contributions that are not aligned to this 17 | Code of Conduct. Project maintainers who do not follow the Code of Conduct may be removed 18 | from the project team. 19 | 20 | Instances of abusive, harassing, or otherwise unacceptable behavior may be reported by 21 | opening an issue or contacting one or more of the project maintainers. 22 | 23 | This Code of Conduct is adapted from the Contributor Covenant 24 | (https://www.contributor-covenant.org), version 1.0.0, available at 25 | https://contributor-covenant.org/version/1/0/0/. 26 | -------------------------------------------------------------------------------- /COPYING: -------------------------------------------------------------------------------- 1 | Copyright (c) 2023 Jeroen Ooms 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: 4 | 5 | The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. 6 | 7 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 8 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: jsonlite 2 | Version: 2.0.0 3 | Title: A Simple and Robust JSON Parser and Generator for R 4 | License: MIT + file LICENSE 5 | Depends: methods 6 | Authors@R: c( 7 | person("Jeroen", "Ooms", role = c("aut", "cre"), email = "jeroenooms@gmail.com", 8 | comment = c(ORCID = "0000-0002-4035-0289")), 9 | person("Duncan", "Temple Lang", role = "ctb"), 10 | person("Lloyd", "Hilaiel", role = "cph", comment="author of bundled libyajl")) 11 | URL: https://jeroen.r-universe.dev/jsonlite 12 | https://arxiv.org/abs/1403.2805 13 | BugReports: https://github.com/jeroen/jsonlite/issues 14 | Maintainer: Jeroen Ooms 15 | VignetteBuilder: knitr, R.rsp 16 | Description: A reasonably fast JSON parser and generator, optimized for statistical 17 | data and the web. Offers simple, flexible tools for working with JSON in R, and 18 | is particularly powerful for building pipelines and interacting with a web API. 19 | The implementation is based on the mapping described in the vignette (Ooms, 2014). 20 | In addition to converting JSON data from/to R objects, 'jsonlite' contains 21 | functions to stream, validate, and prettify JSON data. The unit tests included 22 | with the package verify that all edge cases are encoded and decoded consistently 23 | for use with dynamic data in systems and applications. 24 | Suggests: 25 | httr, 26 | vctrs, 27 | testthat, 28 | knitr, 29 | rmarkdown, 30 | R.rsp, 31 | sf 32 | RoxygenNote: 7.3.2 33 | Encoding: UTF-8 34 | Roxygen: list(markdown = TRUE) 35 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2020 2 | COPYRIGHT HOLDER: Jeroen Ooms 3 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method("[",json) 4 | S3method(print,json) 5 | S3method(print,scalar) 6 | export(as_gzjson_b64) 7 | export(as_gzjson_raw) 8 | export(base64_dec) 9 | export(base64_enc) 10 | export(base64url_dec) 11 | export(base64url_enc) 12 | export(flatten) 13 | export(fromJSON) 14 | export(minify) 15 | export(parse_gzjson_b64) 16 | export(parse_gzjson_raw) 17 | export(parse_json) 18 | export(prettify) 19 | export(rbind_pages) 20 | export(read_json) 21 | export(serializeJSON) 22 | export(stream_in) 23 | export(stream_out) 24 | export(toJSON) 25 | export(unbox) 26 | export(unserializeJSON) 27 | export(validate) 28 | export(write_json) 29 | import(methods) 30 | useDynLib(jsonlite,C_collapse_array) 31 | useDynLib(jsonlite,C_collapse_array_pretty_inner) 32 | useDynLib(jsonlite,C_collapse_array_pretty_outer) 33 | useDynLib(jsonlite,C_collapse_object) 34 | useDynLib(jsonlite,C_collapse_object_pretty) 35 | useDynLib(jsonlite,C_escape_chars) 36 | useDynLib(jsonlite,C_is_datelist) 37 | useDynLib(jsonlite,C_is_recordlist) 38 | useDynLib(jsonlite,C_is_scalarlist) 39 | useDynLib(jsonlite,C_null_to_na) 40 | useDynLib(jsonlite,C_row_collapse_array) 41 | useDynLib(jsonlite,C_row_collapse_object) 42 | useDynLib(jsonlite,C_transpose_list) 43 | useDynLib(jsonlite,R_base64_decode) 44 | useDynLib(jsonlite,R_base64_encode) 45 | useDynLib(jsonlite,R_integer64_to_char) 46 | useDynLib(jsonlite,R_num_to_char) 47 | useDynLib(jsonlite,R_parse) 48 | useDynLib(jsonlite,R_parse_connection) 49 | useDynLib(jsonlite,R_reformat) 50 | useDynLib(jsonlite,R_validate) 51 | -------------------------------------------------------------------------------- /R/apply_by_pages.R: -------------------------------------------------------------------------------- 1 | apply_by_pages <- function(x, FUN, pagesize, verbose, ...) { 2 | stopifnot(is.data.frame(x)) 3 | nr <- nrow(x) 4 | npages <- nr %/% pagesize 5 | lastpage <- nr %% pagesize 6 | 7 | out <- as.list(rep(NA, npages + as.logical(lastpage))) 8 | for (i in seq_len(npages)) { 9 | from <- pagesize * (i - 1) + 1 10 | to <- pagesize * i 11 | out[[i]] <- FUN(x[from:to, , drop = FALSE], ...) 12 | if (verbose) cat("\rProcessed", i * pagesize, "rows...") 13 | } 14 | 15 | if (lastpage) { 16 | from <- nr - lastpage + 1 17 | out[[npages + 1]] <- FUN(x[from:nr, , drop = FALSE], ...) 18 | } 19 | if (verbose) cat("\rComplete! Processed total of", nr, "rows.\n") 20 | out 21 | } 22 | 23 | #this is another slightly slower implementation 24 | apply_by_pages2 <- function(x, FUN, pagesize, verbose, ...) { 25 | x2 <- split(x, seq_len(nrow(x)) %/% pagesize) 26 | for (page in x2) { 27 | if (verbose) message("Writing ", nrow(page), " lines (", ").") 28 | FUN(page) 29 | } 30 | invisible() 31 | } 32 | 33 | #' @export 34 | `[.json` <- function(x, i) { 35 | structure(NextMethod("["), class = c("json", "character")) 36 | } 37 | -------------------------------------------------------------------------------- /R/as.scalar.R: -------------------------------------------------------------------------------- 1 | as.scalar <- function(obj) { 2 | # Lists can never be a scalar (this can arise if a dataframe contains a column 3 | # with lists) 4 | if (length(dim(obj)) > 1) { 5 | if (!identical(nrow(obj), 1L)) { 6 | warning("Tried to use as.scalar on an array or dataframe with ", nrow(obj), " rows.", call. = FALSE) 7 | return(obj) 8 | } 9 | } else if (!identical(length(obj), 1L)) { 10 | warning("Tried to use as.scalar on an object of length ", length(obj), call. = FALSE) 11 | return(obj) 12 | } else if (is.namedlist(obj)) { 13 | warning("Tried to use as.scalar on a named list.", call. = FALSE) 14 | return(obj) 15 | } 16 | 17 | class(obj) <- c("scalar", class(obj)) 18 | return(obj) 19 | } 20 | -------------------------------------------------------------------------------- /R/asJSON.AAAgeneric.R: -------------------------------------------------------------------------------- 1 | setGeneric("asJSON", function(x, ...) { 2 | standardGeneric("asJSON") 3 | }) 4 | 5 | if (getRversion() < "4") { 6 | setOldClass("AsIs") 7 | setOldClass("integer64") 8 | setOldClass(c("hms", "difftime")) 9 | setOldClass("ITime") 10 | setOldClass("json") 11 | setOldClass("pairlist") 12 | setOldClass("scalar") 13 | setOldClass("sf") 14 | setOldClass("sfc") 15 | } 16 | -------------------------------------------------------------------------------- /R/asJSON.ANY.R: -------------------------------------------------------------------------------- 1 | #' @import methods 2 | setMethod("asJSON", "ANY", function(x, force = FALSE, ...) { 3 | if (isS4(x) && !is(x, "classRepresentation")) { 4 | if (isTRUE(force)) { 5 | return(asJSON(attributes(x), force = force, ...)) 6 | } else { 7 | stop("No method for S4 class:", class(x)) 8 | } 9 | } else if (length(class(x)) > 1) { 10 | # If an object has multiple classes, we recursively try the next class. This is 11 | # S3 style dispatching that doesn't work by default for formal method definitions 12 | # There should be a more native way to accomplish this 13 | return(asJSON(structure(x, class = class(x)[-1]), force = force, ...)) 14 | } else if (isTRUE(force) && existsMethod("asJSON", class(unclass(x))[1])) { 15 | # As a last resort we can force encoding using the unclassed object 16 | return(asJSON(unclass(x), force = force, ...)) 17 | } else if (isTRUE(force)) { 18 | return(asJSON(NULL)) 19 | warning("No method asJSON S3 class: ", class(x)) 20 | } else { 21 | # If even that doesn't work, we give up. 22 | stop("No method asJSON S3 class: ", class(x)) 23 | } 24 | }) 25 | -------------------------------------------------------------------------------- /R/asJSON.AsIs.R: -------------------------------------------------------------------------------- 1 | setMethod("asJSON", "AsIs", function(x, auto_unbox = FALSE, ...) { 2 | # Strip off the AsIs class so we can dispatch to other asJSON methods. 3 | class(x) <- setdiff(class(x), "AsIs") 4 | 5 | if (is.atomic(x) && length(x) == 1) { 6 | # Never auto_unbox single values when wrapped with I() 7 | asJSON(x, auto_unbox = FALSE, ...) 8 | } else { 9 | asJSON(x, auto_unbox = auto_unbox, ...) 10 | } 11 | }) 12 | -------------------------------------------------------------------------------- /R/asJSON.Date.R: -------------------------------------------------------------------------------- 1 | setMethod("asJSON", "Date", function(x, Date = c("ISO8601", "epoch"), always_decimal = FALSE, ...) { 2 | # Validate argument 3 | Date <- match.arg(Date) 4 | 5 | # select a schema 6 | output <- switch( 7 | Date, 8 | ISO8601 = format(x), 9 | epoch = unclass(x), 10 | default = stop("Invalid argument for 'Date':", Date) 11 | ) 12 | 13 | # Dispatch to character encoding 14 | asJSON(output, always_decimal = FALSE, ...) 15 | }) 16 | -------------------------------------------------------------------------------- /R/asJSON.ITime.R: -------------------------------------------------------------------------------- 1 | setMethod("asJSON", "ITime", function(x, ...) { 2 | asJSON(as.character(x), ...) 3 | }) 4 | -------------------------------------------------------------------------------- /R/asJSON.NULL.R: -------------------------------------------------------------------------------- 1 | # Note that this is different from RJSONIO because null values are NA. 2 | setMethod("asJSON", "NULL", function(x, null = "list", ...) { 3 | if (null == "null") { 4 | return("null") 5 | } else { 6 | return("{}") 7 | } 8 | }) 9 | -------------------------------------------------------------------------------- /R/asJSON.POSIXt.R: -------------------------------------------------------------------------------- 1 | setMethod("asJSON", "POSIXt", function(x, POSIXt = c("string", "ISO8601", "epoch", "mongo"), UTC = FALSE, digits, time_format = NULL, always_decimal = FALSE, ...) { 2 | # note: UTC argument doesn't seem to be working consistently maybe use ?format 3 | # instead of ?as.character 4 | 5 | # Validate 6 | POSIXt <- match.arg(POSIXt) 7 | 8 | # Encode based on a schema 9 | if (POSIXt == "mongo") { 10 | return(asJSON_posix_mongo(x, ...)) 11 | } 12 | 13 | # Epoch millis 14 | if (POSIXt == "epoch") { 15 | return(asJSON(floor(unclass(as.POSIXct(x)) * 1000), digits = digits, always_decimal = FALSE, ...)) 16 | } 17 | 18 | # Strings 19 | if (is.null(time_format)) { 20 | time_format <- if (POSIXt == "string") { 21 | "" 22 | } else if (isTRUE(UTC)) { 23 | "%Y-%m-%dT%H:%M:%SZ" 24 | } else { 25 | "%Y-%m-%dT%H:%M:%S" 26 | } 27 | } 28 | 29 | if (isTRUE(UTC)) { 30 | asJSON(format(x, format = time_format, tz = "UTC"), ...) 31 | } else { 32 | asJSON(format(x, format = time_format), ...) 33 | } 34 | }) 35 | 36 | asJSON_posix_mongo <- function(x, collapse = TRUE, indent = NA_integer_, ...) { 37 | if (inherits(x, "POSIXlt")) { 38 | x <- as.POSIXct(x) 39 | } 40 | df <- data.frame("$date" = floor(unclass(x) * 1000), check.names = FALSE) 41 | if (inherits(x, "scalar")) class(df) <- c("scalar", class(df)) 42 | tmp <- asJSON(df, digits = NA, always_decimal = FALSE, ..., collapse = FALSE) 43 | tmp[is.na(x)] <- asJSON(NA_character_, collapse = FALSE, ...) 44 | if (isTRUE(collapse)) { 45 | collapse(tmp, inner = FALSE, indent = indent) 46 | } else { 47 | tmp 48 | } 49 | } 50 | -------------------------------------------------------------------------------- /R/asJSON.array.R: -------------------------------------------------------------------------------- 1 | asjson_array_fun <- function(x, collapse = TRUE, na = NULL, oldna = NULL, matrix = c("rowmajor", "columnmajor"), auto_unbox = FALSE, keep_vec_names = FALSE, indent = NA_integer_, ...) { 2 | matrix <- match.arg(matrix) 3 | 4 | # reset na arg when called from data frame 5 | if (identical(na, "NA")) { 6 | na <- oldna 7 | } 8 | 9 | # 1D arrays are vectors 10 | if (length(dim(x)) < 2) { 11 | return(asJSON(c(x), matrix = matrix, na = na, indent = indent_increment(indent), ...)) 12 | } 13 | 14 | # if collapse == FALSE, then this matrix is nested inside a data frame, 15 | # and therefore row major must be forced to match dimensions 16 | if (identical(matrix, "columnmajor") && collapse == FALSE) { 17 | return(apply(x, 1, asJSON, matrix = matrix, na = na, indent = indent_increment(indent), ...)) 18 | } 19 | 20 | # dont pass auto_unbox (never unbox within matrix) 21 | m <- asJSON(c(x), collapse = FALSE, matrix = matrix, na = na, ...) 22 | dim(m) <- dim(x) 23 | tmp <- if (length(dim(x)) == 2 && identical(matrix, "rowmajor")) { 24 | # Faster special case for 2D matrices 25 | row_collapse(m, indent = indent_increment(indent)) 26 | } else { 27 | collapse_array(m, columnmajor = identical(matrix, "columnmajor"), indent = indent) 28 | } 29 | 30 | # collapse it 31 | if (collapse) { 32 | collapse(tmp, inner = FALSE, indent = indent) 33 | } else { 34 | tmp 35 | } 36 | } 37 | 38 | # Some objects have class Matrix but not class Array 39 | setMethod("asJSON", "array", asjson_array_fun) 40 | setMethod("asJSON", "matrix", asjson_array_fun) 41 | -------------------------------------------------------------------------------- /R/asJSON.character.R: -------------------------------------------------------------------------------- 1 | setMethod("asJSON", "character", function(x, collapse = TRUE, na = c("null", "string", "NA"), auto_unbox = FALSE, keep_vec_names = FALSE, indent = NA_integer_, ...) { 2 | # Needed for multi-byte Windows locales 3 | # See: https://github.com/jeroen/jsonlite/issues/329 4 | x <- enc2utf8(x) 5 | 6 | # shiny legacy exception 7 | if (isTRUE(keep_vec_names) && length(names(x))) { 8 | warn_keep_vec_names() 9 | return(asJSON(as.list(x), na = na, auto_unbox = TRUE, collapse = collapse, ...)) 10 | } 11 | 12 | # vectorized escaping 13 | tmp <- deparse_vector(x) 14 | 15 | # this was used with deparse_vector_old 16 | #if(identical(Encoding(x), "UTF-8")){ 17 | # if(!grepl("UTF", Sys.getlocale("LC_CTYPE"), ignore.case=TRUE)){ 18 | # tmp <- utf8conv(tmp); 19 | # } 20 | #} 21 | 22 | # validate NA 23 | if (any(missings <- which(is.na(x)))) { 24 | na <- match.arg(na) 25 | if (na %in% c("null")) { 26 | tmp[missings] <- "null" 27 | } else if (na %in% "string") { 28 | tmp[missings] <- "\"NA\"" 29 | } else { 30 | tmp[missings] <- NA_character_ 31 | } 32 | } 33 | 34 | if (isTRUE(auto_unbox) && length(tmp) == 1) { 35 | return(tmp) 36 | } 37 | 38 | # this is almost always true, except for class 'scalar' 39 | if (isTRUE(collapse)) { 40 | collapse(tmp, indent = indent) 41 | } else { 42 | tmp 43 | } 44 | }) 45 | -------------------------------------------------------------------------------- /R/asJSON.classRepresentation.R: -------------------------------------------------------------------------------- 1 | # classRepresentation is an object that defines an S4 class encoding it usually 2 | # doesn't serve much purpose, however as we don't wnat to encode it as a regular 3 | # S4 data object. 4 | 5 | # it currently only encodes the slots. we could add encoding of methods of that 6 | # would be desired. 7 | 8 | setMethod("asJSON", "classRepresentation", function(x, ...) { 9 | return(asJSON(attributes(x)$slots, ...)) 10 | }) 11 | -------------------------------------------------------------------------------- /R/asJSON.complex.R: -------------------------------------------------------------------------------- 1 | setMethod("asJSON", "complex", function(x, digits = 5, collapse = TRUE, complex = c("string", "list"), na = c("string", "null", "NA"), oldna = NULL, ...) { 2 | # validate 3 | na <- match.arg(na) 4 | complex <- match.arg(complex) 5 | 6 | #turn into strings 7 | if (complex == "string") { 8 | #default NA is "NA" 9 | mystring <- prettyNum(x = x, digits = digits) 10 | if (any(missings <- which(!is.finite(x)))) { 11 | if (na %in% c("null", "NA")) { 12 | mystring[missings] <- NA_character_ 13 | } 14 | } 15 | asJSON(mystring, collapse = collapse, na = na, ...) 16 | } else { 17 | if (na == "NA") { 18 | na <- oldna 19 | } 20 | asJSON(list(real = Re(x), imaginary = Im(x)), na = na, digits = digits, ...) 21 | } 22 | }) 23 | -------------------------------------------------------------------------------- /R/asJSON.data.frame.R: -------------------------------------------------------------------------------- 1 | setMethod("asJSON", "data.frame", function(x, na = c("NA", "null", "string"), collapse = TRUE, dataframe = c("rows", "columns", "values"), complex = "string", oldna = NULL, rownames = NULL, keep_vec_names = FALSE, indent = NA_integer_, no_dots = FALSE, ...) { 2 | # Coerse pairlist if needed 3 | if (is.pairlist(x)) { 4 | x <- as.vector(x, mode = "list") 5 | } 6 | 7 | # Validate some args 8 | dataframe <- match.arg(dataframe) 9 | has_names <- identical(length(names(x)), ncol(x)) 10 | 11 | # Default to adding row names only if they are strings and not just stringified numbers 12 | if (isTRUE(rownames) || (is.null(rownames) && is.character(attr(x, "row.names")) && !all(grepl("^\\d+$", row.names(x))))) { 13 | # we don't use row.names() because this converts numbers to strings, 14 | # which will break sorting 15 | if (has_names) { 16 | x[["_row"]] <- attr(x, "row.names") 17 | } 18 | } 19 | 20 | # Unname named lists columns. These are very rare. 21 | namedlistvars <- which(vapply(x, is.namedlistnotdf, logical(1))) 22 | for (i in namedlistvars) { 23 | x[[i]] <- unname(x[[i]]) 24 | } 25 | 26 | # Convert POSIXlt to POSIXct before we start messing with lists 27 | posvars <- which(vapply(x, is, logical(1), "POSIXlt")) 28 | for (i in posvars) { 29 | x[[i]] <- as.POSIXct(x[[i]]) 30 | } 31 | 32 | # Column based is same as list. Do not pass collapse arg because it is a named list. 33 | if (dataframe == "columns") { 34 | return(asJSON(as.list(x), is_df = TRUE, na = na, dataframe = dataframe, complex = complex, rownames = rownames, indent = indent, no_dots = no_dots, ...)) 35 | } 36 | 37 | # Determine "oldna". This is needed when the data frame contains a list column 38 | if (missing(na) || !length(na) || identical(na, "NA")) { 39 | oldna <- NULL 40 | } else { 41 | oldna <- na 42 | } 43 | 44 | # Set default for row based, don't do it earlier because it will affect 'oldna' or dataframe="columns" 45 | if (dataframe == "rows" && has_names) { 46 | na <- match.arg(na) 47 | } 48 | 49 | # no records 50 | if (!nrow(x)) { 51 | return(asJSON(list(), collapse = collapse, indent = indent)) 52 | } 53 | 54 | # Convert raw vectors 55 | rawvars <- which(vapply(x, is.raw, logical(1))) 56 | for (i in rawvars) { 57 | x[[i]] <- as.character.hexmode(x[[i]]) 58 | } 59 | 60 | # Turn complex vectors into data frames 61 | if (complex == "list") { 62 | complxvars <- which(vapply(x, is.complex, logical(1))) 63 | for (i in complxvars) { 64 | x[[i]] <- data.frame(real = Re(x[[i]]), imaginary = Im(x[[i]])) 65 | } 66 | } 67 | 68 | #create a matrix of json elements 69 | dfnames <- deparse_vector(cleannames(names(x), no_dots = no_dots)) 70 | out <- vapply(x, asJSON, character(nrow(x)), collapse = FALSE, complex = complex, na = na, oldna = oldna, rownames = rownames, dataframe = dataframe, indent = indent_increment(indent), no_dots = no_dots, ..., USE.NAMES = FALSE) 71 | 72 | # This would be another way of doing the missing values 73 | # This does not require the individual classes to support na="NA" 74 | #if(identical(na, "NA")){ 75 | # namatrix <- vapply(x, is.na, logical(nrow(x))) 76 | # out[namatrix] <- NA; 77 | #} 78 | 79 | #this is a workaround for vapply simplifying into a vector for n=1 (not for n=0 surprisingly) 80 | if (!is.matrix(out)) { 81 | out <- t(out) 82 | } 83 | 84 | # turn the matrix into json records 85 | # note: special row_collapse functions because apply is slow! 86 | tmp <- if (dataframe == "rows" && (length(dfnames) == ncol(out))) { 87 | #apply(out, 1, collapse_object, x = dfnames, indent = indent + 2L); 88 | row_collapse_object(dfnames, out, indent = indent_increment(indent)) 89 | } else { 90 | # for dataframe = "values" 91 | #apply(out, 1, collapse, indent = indent); 92 | row_collapse(out, indent = indent) 93 | } 94 | 95 | #collapse 96 | if (isTRUE(collapse)) { 97 | collapse(tmp, inner = FALSE, indent = indent) 98 | } else { 99 | tmp 100 | } 101 | }) 102 | 103 | is.namedlistnotdf <- function(x) { 104 | isTRUE(is.list(x) && !is.data.frame(x) && !is.null(names(x))) 105 | } 106 | -------------------------------------------------------------------------------- /R/asJSON.difftime.R: -------------------------------------------------------------------------------- 1 | setMethod("asJSON", "ts", function(x, ...) { 2 | asJSON(as.vector(x), ...) 3 | }) 4 | 5 | setMethod("asJSON", "hms", function(x, hms = c("string", "secs"), ...) { 6 | hms <- match.arg(hms) 7 | output <- switch(hms, string = as.character(x), secs = as.numeric(x, units = "secs")) 8 | output[is.na(x)] <- NA 9 | asJSON(output, ...) 10 | }) 11 | -------------------------------------------------------------------------------- /R/asJSON.factor.R: -------------------------------------------------------------------------------- 1 | setMethod("asJSON", "factor", function(x, factor = c("string", "integer"), keep_vec_names = FALSE, ...) { 2 | # validate 3 | factor <- match.arg(factor) 4 | 5 | # dispatch 6 | if (factor == "integer") { 7 | # encode factor as enum 8 | asJSON(unclass(x), ...) 9 | } else { 10 | # encode as strings 11 | xc <- as.character(x) 12 | if (isTRUE(keep_vec_names)) { 13 | names(xc) <- names(x) 14 | } 15 | asJSON(xc, keep_vec_names = keep_vec_names, ...) 16 | } 17 | }) 18 | -------------------------------------------------------------------------------- /R/asJSON.function.R: -------------------------------------------------------------------------------- 1 | setMethod("asJSON", "function", function(x, collapse = TRUE, fun = c("source", "list"), ...) { 2 | # validate 3 | fun <- match.arg(fun) 4 | 5 | if (fun == "source") { 6 | return(asJSON(deparse(x), ...)) 7 | } else { 8 | return(asJSON(as.list(x), ...)) 9 | } 10 | }) 11 | -------------------------------------------------------------------------------- /R/asJSON.int64.R: -------------------------------------------------------------------------------- 1 | #setOldClass("int64") 2 | #setMethod("asJSON", "int64", function(x, digits, ...) { 3 | # asJSON(as.double(as.character(x)), digits = 0, ...) 4 | #}) 5 | -------------------------------------------------------------------------------- /R/asJSON.json.R: -------------------------------------------------------------------------------- 1 | # If an object has already been encoded by toJSON(), do not encode it again 2 | setMethod("asJSON", "json", function(x, json_verbatim = FALSE, ...) { 3 | if (isTRUE(json_verbatim)) { 4 | x 5 | } else { 6 | asJSON(as.character(x), ...) 7 | } 8 | }) 9 | -------------------------------------------------------------------------------- /R/asJSON.list.R: -------------------------------------------------------------------------------- 1 | setMethod("asJSON", "list", function(x, collapse = TRUE, na = NULL, oldna = NULL, is_df = FALSE, auto_unbox = FALSE, indent = NA_integer_, no_dots = FALSE, ...) { 2 | # reset na arg when called from data frame 3 | if (identical(na, "NA")) { 4 | na <- oldna 5 | } 6 | 7 | # coerse pairlist if needed 8 | if (is.pairlist(x)) { 9 | x <- as.vector(x, mode = "list") 10 | } 11 | 12 | # empty vector 13 | #if (!length(x)) { 14 | # if(collapse) { 15 | # return(if (is.null(names(x))) "[]" else "{}") 16 | # } else { 17 | # return(character()) 18 | # } 19 | #} 20 | 21 | # this condition appears when a dataframe contains a column with lists we need to 22 | # do this, because the [ operator always returns a list of length 1 23 | # if (length(x) == 1 && is.null(names(x)) && collapse == FALSE) { 24 | # return(asJSON(x[[1]], ...)) 25 | # } 26 | 27 | # note we are NOT passing on the container argument. 28 | tmp <- if (is_df && auto_unbox) { 29 | vapply( 30 | x, 31 | function(y, ...) { 32 | asJSON(y, auto_unbox = is.list(y), ...) 33 | }, 34 | character(1), 35 | na = na, 36 | indent = indent_increment(indent), 37 | no_dots = no_dots, 38 | ... 39 | ) 40 | } else { 41 | vapply(x, asJSON, character(1), na = na, auto_unbox = auto_unbox, indent = indent_increment(indent), no_dots = no_dots, ...) 42 | } 43 | 44 | if (!is.null(names(x))) { 45 | if (!collapse) { 46 | #this should never happen 47 | warning("collapse=FALSE called for named list.") 48 | } 49 | #in case of named list: 50 | objnames <- deparse_vector(cleannames(names(x), no_dots = no_dots)) 51 | collapse_object(objnames, tmp, indent) 52 | } else { 53 | #in case of unnamed list: 54 | if (collapse) { 55 | collapse(tmp, inner = FALSE, indent) 56 | } else { 57 | tmp 58 | } 59 | } 60 | }) 61 | -------------------------------------------------------------------------------- /R/asJSON.logical.R: -------------------------------------------------------------------------------- 1 | setMethod("asJSON", "logical", function(x, collapse = TRUE, na = c("null", "string", "NA"), auto_unbox = FALSE, keep_vec_names = FALSE, indent = NA_integer_, ...) { 2 | # shiny legacy exception 3 | if (isTRUE(keep_vec_names) && length(names(x))) { 4 | warn_keep_vec_names() 5 | return(asJSON(as.list(x), collapse = collapse, na = na, auto_unbox = TRUE, ...)) 6 | } 7 | 8 | # validate arg 9 | na <- match.arg(na) 10 | 11 | # json true/false 12 | tmp <- ifelse(x, "true", "false") 13 | 14 | # replace missing values, unless na="NA" 15 | if (!identical(na, "NA")) { 16 | # logical values can have NA (but not Inf/NaN). Default is to encode as null. 17 | if (any(missings <- which(is.na(x)))) { 18 | tmp[missings] <- ifelse(identical(na, "string"), "\"NA\"", "null") 19 | } 20 | } 21 | 22 | #this is needed when !length(tmp) or all(is.na(tmp)) 23 | if (!is.character(tmp)) { 24 | tmp <- as.character(tmp) 25 | } 26 | 27 | if (isTRUE(auto_unbox) && length(tmp) == 1) { 28 | return(tmp) 29 | } 30 | 31 | # collapse it 32 | if (collapse) { 33 | collapse(tmp, indent = indent) 34 | } else { 35 | tmp 36 | } 37 | }) 38 | -------------------------------------------------------------------------------- /R/asJSON.numeric.R: -------------------------------------------------------------------------------- 1 | asjson_numeric_fun <- function(x, digits = 5, use_signif = is(digits, "AsIs"), na = c("string", "null", "NA"), auto_unbox = FALSE, collapse = TRUE, keep_vec_names = FALSE, indent = NA_integer_, always_decimal = FALSE, ...) { 2 | # shiny legacy exception 3 | if (isTRUE(keep_vec_names) && length(names(x))) { 4 | warn_keep_vec_names() 5 | return(asJSON(as.list(x), digits = digits, use_signif = use_signif, na = na, auto_unbox = TRUE, collapse = collapse, ...)) 6 | } 7 | 8 | na <- match.arg(na) 9 | na_as_string <- switch(na, "string" = TRUE, "null" = FALSE, "NA" = NA, stop("invalid na_as_string")) 10 | 11 | # old R implementation 12 | # tmp <- num_to_char_R(x, digits, na_as_string); 13 | 14 | # fast C implementation 15 | tmp <- if (is(x, "integer64")) { 16 | integer64_to_char(x, na_as_string) 17 | } else { 18 | num_to_char(x, digits, na_as_string, use_signif, always_decimal) 19 | } 20 | 21 | if (isTRUE(auto_unbox) && length(tmp) == 1) { 22 | return(tmp) 23 | } 24 | 25 | if (collapse) { 26 | collapse(tmp, indent = indent) 27 | } else { 28 | tmp 29 | } 30 | } 31 | 32 | # This is for the bit64 package 33 | setMethod("asJSON", "numeric", asjson_numeric_fun) 34 | setMethod("asJSON", "integer64", asjson_numeric_fun) 35 | -------------------------------------------------------------------------------- /R/asJSON.pairlist.R: -------------------------------------------------------------------------------- 1 | setMethod("asJSON", "pairlist", function(x, ...) { 2 | asJSON(as.vector(x, mode = "list"), ...) 3 | }) 4 | -------------------------------------------------------------------------------- /R/asJSON.raw.R: -------------------------------------------------------------------------------- 1 | setMethod("asJSON", "blob", function(x, raw = "base64", ...) { 2 | if (identical(raw, "base64")) { 3 | str <- vapply(x, base64_enc, character(1)) 4 | return(asJSON(str, ...)) 5 | } 6 | asJSON(as.list(x), raw = raw, ...) 7 | }) 8 | 9 | setMethod("asJSON", "raw", function(x, raw = c("base64", "hex", "mongo", "int", "js"), ...) { 10 | # validate 11 | raw <- match.arg(raw) 12 | 13 | # encode based on schema 14 | if (raw == "mongo") { 15 | type <- ifelse(length(attr(x, "type")), attr(x, "type"), 5) 16 | return(asJSON(list(`$binary` = as.scalar(base64_enc(x)), `$type` = as.scalar(as.character(type))))) 17 | } else if (raw == "hex") { 18 | return(asJSON(as.character.hexmode(x), ...)) 19 | } else if (raw == "int") { 20 | return(asJSON(as.integer(x), ...)) 21 | } else if (raw == "js") { 22 | paste0('(new Uint8Array(', asJSON(as.integer(x), collapse = TRUE), '))') 23 | } else { 24 | # no as scalar here! 25 | return(asJSON(base64_enc(x), ...)) 26 | } 27 | }) 28 | -------------------------------------------------------------------------------- /R/asJSON.scalar.R: -------------------------------------------------------------------------------- 1 | setMethod("asJSON", "scalar", function(x, collapse, ...) { 2 | # TODO: There must be a way to do this with NextMethod() 3 | if (length(class(x)) > 1) { 4 | class(x) <- class(x)[-1] 5 | } else { 6 | x <- unclass(x) 7 | } 8 | 9 | # Print JSON without [] 10 | return(asJSON(x, collapse = FALSE, ...)) 11 | }) 12 | -------------------------------------------------------------------------------- /R/asJSON.sf.R: -------------------------------------------------------------------------------- 1 | # For 'sf' geometry columns; use same structure as GeoJSON 2 | setMethod("asJSON", "sf", function(x, sf = c("dataframe", "features", "geojson"), ...) { 3 | sf <- match.arg(sf) 4 | if (sf == 'dataframe') { 5 | callNextMethod() 6 | } else { 7 | sf_column <- attr(x, 'sf_column') 8 | if (!length(sf_column)) sf_column <- 'geometry' 9 | geometry <- x[[sf_column]] 10 | input <- as.data.frame(x) 11 | features <- data.frame(type = rep('Feature', nrow(input)), stringsAsFactors = FALSE) 12 | features$properties = input[names(input) != sf_column] 13 | features$geometry = geometry 14 | if (sf == 'features') { 15 | asJSON(features, sf = sf, ...) 16 | } else { 17 | output <- list( 18 | type = unbox('FeatureCollection'), 19 | name = unbox('sfdata'), 20 | features = features 21 | ) 22 | asJSON(output, sf = sf, ...) 23 | } 24 | } 25 | }) 26 | 27 | setMethod("asJSON", "sfc", function(x, ...) { 28 | y <- lapply(unclass(x), geom_to_geojson) 29 | asJSON(y, ...) 30 | }) 31 | 32 | geom_to_geojson <- function(x) { 33 | val <- list( 34 | type = unbox(sf_to_titlecase(class(x)[2])) # see: sf::st_geometry_type 35 | ) 36 | if (inherits(x, "GEOMETRYCOLLECTION")) { 37 | val$geometries = lapply(x, geom_to_geojson) 38 | } else { 39 | val$coordinates = unclass(x) 40 | } 41 | return(val) 42 | } 43 | 44 | # See sf::sf.tp 45 | sf_to_titlecase <- function(x) { 46 | sf_types <- 47 | c("Point", "LineString", "Polygon", "MultiPoint", "MultiLineString", "MultiPolygon", "GeometryCollection", "CircularString", "CompoundCurve", "CurvePolygon", "MultiCurve", "MultiSurface", "Curve", "Surface", "PolyhedralSurface", "TIN", "Triangle") 48 | matches <- match(as.character(x), toupper(sf_types)) 49 | sf_types[matches] 50 | } 51 | -------------------------------------------------------------------------------- /R/asJSON.vctrs.R: -------------------------------------------------------------------------------- 1 | setMethod("asJSON", "vctrs_vctr", function(x, ...) { 2 | # dispatch based on the underlying type 3 | class(x) <- setdiff(class(x), 'vctrs_vctr') 4 | asJSON(x, ...) 5 | }) 6 | -------------------------------------------------------------------------------- /R/base64.R: -------------------------------------------------------------------------------- 1 | #' Encode/decode base64 2 | #' 3 | #' Simple in-memory base64 encoder and decoder. Used internally for converting 4 | #' raw vectors to text. Interchangeable with encoder from `base64enc` or 5 | #' `openssl` package. 6 | #' 7 | #' The [base64url_enc] and [base64url_dec] functions use a variation of base64 8 | #' that substitute characters `+/` for `-_` respectively, such that the output 9 | #' does not require URL-encoding. See also section 5 of rfc4648. 10 | #' 11 | #' @param input string or raw vector to be encoded/decoded 12 | #' @export 13 | #' @rdname base64 14 | #' @name base64 15 | #' @useDynLib jsonlite R_base64_decode 16 | #' @examples str <- base64_enc(serialize(iris, NULL)) 17 | #' out <- unserialize(base64_dec(str)) 18 | #' stopifnot(identical(out, iris)) 19 | base64_dec <- function(input) { 20 | if (is.character(input)) { 21 | input <- charToRaw(paste(input, collapse = "\n")) 22 | } 23 | stopifnot(is.raw(input)) 24 | .Call(R_base64_decode, input) 25 | } 26 | 27 | #' @export 28 | #' @rdname base64 29 | #' @useDynLib jsonlite R_base64_encode 30 | base64_enc <- function(input) { 31 | if (is.null(input)) return(NA_character_) 32 | if (is.character(input)) { 33 | input <- charToRaw(paste(input, collapse = "\n")) 34 | } 35 | stopifnot(is.raw(input)) 36 | .Call(R_base64_encode, input) 37 | } 38 | 39 | #' @export 40 | #' @rdname base64 41 | base64url_enc <- function(input) { 42 | text <- base64_enc(input) 43 | sub("=+$", "", chartr('+/', '-_', text)) 44 | } 45 | 46 | #' @export 47 | #' @rdname base64 48 | base64url_dec <- function(input) { 49 | text <- fix_padding(chartr('-_', '+/', input)) 50 | base64_dec(text) 51 | } 52 | 53 | # Ensures base64 length is a multiple of 4 54 | fix_padding <- function(text) { 55 | text <- gsub("[\r\n]", "", text)[[1]] 56 | mod <- nchar(text) %% 4 57 | if (mod > 0) { 58 | padding <- paste(rep("=", (4 - mod)), collapse = "") 59 | text <- paste0(text, padding) 60 | } 61 | text 62 | } 63 | -------------------------------------------------------------------------------- /R/cleannames.R: -------------------------------------------------------------------------------- 1 | cleannames <- function(objnames, no_dots = FALSE) { 2 | objnames[objnames == ""] <- NA_character_ 3 | is_missing <- is.na(objnames) 4 | objnames[is_missing] <- as.character(seq_len(length(objnames)))[is_missing] 5 | if (isTRUE(no_dots)) objnames <- gsub(".", "_", objnames, fixed = TRUE) 6 | make.unique(objnames) 7 | } 8 | -------------------------------------------------------------------------------- /R/collapse.R: -------------------------------------------------------------------------------- 1 | #' @useDynLib jsonlite C_collapse_array C_collapse_array_pretty_inner C_collapse_array_pretty_outer 2 | collapse <- function(x, inner = TRUE, indent = 0L) { 3 | if (is.na(indent)) { 4 | .Call(C_collapse_array, x) 5 | } else if (isTRUE(inner)) { 6 | .Call(C_collapse_array_pretty_inner, x) 7 | } else { 8 | .Call(C_collapse_array_pretty_outer, x, indent) 9 | } 10 | } 11 | 12 | #' @useDynLib jsonlite C_row_collapse_array 13 | row_collapse <- function(m, indent = NA_integer_) { 14 | .Call(C_row_collapse_array, m, indent = indent) 15 | } 16 | 17 | 18 | # Iteratively collapse a high dimensional matrix / array 19 | # Does not perform the final collapse, which is done in asJSON.array() 20 | collapse_array <- function(x, columnmajor = FALSE, indent) { 21 | # dimensionality of the array 22 | n <- length(dim(x)) 23 | 24 | # Collapse the inner vectors 25 | dim <- 1:(n - 1) + as.numeric(columnmajor) 26 | x <- apply(x, dim, collapse, inner = TRUE, indent = indent) 27 | 28 | # Collapse higher dimensions 29 | for (i in rev(seq_along(dim(x)))[-1]) { 30 | dim <- 1:(length(dim(x)) - 1) + as.numeric(columnmajor) 31 | x <- apply(x, dim, collapse, inner = FALSE, indent = indent_increment(indent) * i) 32 | } 33 | x 34 | } 35 | -------------------------------------------------------------------------------- /R/collapse_object.R: -------------------------------------------------------------------------------- 1 | #' @useDynLib jsonlite C_collapse_object C_collapse_object_pretty 2 | collapse_object <- function(x, y, indent = 0L) { 3 | if (is.na(indent)) { 4 | .Call(C_collapse_object, x, y) 5 | } else { 6 | .Call(C_collapse_object_pretty, x, y, indent) 7 | } 8 | } 9 | 10 | #' @useDynLib jsonlite C_row_collapse_object 11 | row_collapse_object <- function(x, m, indent = NA_integer_) { 12 | .Call(C_row_collapse_object, x, m, indent = indent) 13 | } 14 | -------------------------------------------------------------------------------- /R/deparse_vector.R: -------------------------------------------------------------------------------- 1 | #' @useDynLib jsonlite C_escape_chars 2 | deparse_vector_c <- function(x) { 3 | .Call(C_escape_chars, x) 4 | } 5 | 6 | deparse_vector_r <- function(x) { 7 | stopifnot(is.character(x)) 8 | if (!length(x)) return(x) 9 | x <- gsub("\\", "\\\\", x, fixed = TRUE) 10 | x <- gsub("\"", "\\\"", x, fixed = TRUE) 11 | x <- gsub("\n", "\\n", x, fixed = TRUE) 12 | x <- gsub("\r", "\\r", x, fixed = TRUE) 13 | x <- gsub("\t", "\\t", x, fixed = TRUE) 14 | x <- gsub("\b", "\\b", x, fixed = TRUE) 15 | x <- gsub("\f", "\\f", x, fixed = TRUE) 16 | paste0("\"", x, "\"") 17 | } 18 | 19 | # Which implementation to use 20 | deparse_vector <- deparse_vector_c 21 | 22 | #Below are older implementations of the same function 23 | deparse_vector_old <- function(x) { 24 | stopifnot(is.character(x)) 25 | x <- gsub("[\v\a]", "", x) 26 | vapply(x, deparse, character(1), USE.NAMES = FALSE) 27 | } 28 | -------------------------------------------------------------------------------- /R/fixNativeSymbol.R: -------------------------------------------------------------------------------- 1 | fixNativeSymbol <- function(symbol) { 2 | if (is(symbol, "NativeSymbolInfo")) { 3 | # method depends on version 4 | rVersion <- getRversion() 5 | 6 | if (rVersion >= "3.0") { 7 | # in R 3.0 determine the dll that the symbol lives in 8 | name <- ifelse(is.null(symbol$package), symbol$dll[["name"]], symbol$package[["name"]]) 9 | 10 | # load package if not yet loaded 11 | try(getNamespace(name)) 12 | pkgDLL <- getLoadedDLLs()[[name]] 13 | 14 | # reconstruct the native symbol address 15 | newsymbol <- getNativeSymbolInfo(name = symbol$name, PACKAGE = pkgDLL, withRegistrationInfo = TRUE) 16 | symbol$address <- newsymbol$address 17 | return(symbol) 18 | } else if (rVersion >= "2.14") { 19 | return(getNativeSymbolInfo(symbol$name)) 20 | } 21 | } else { 22 | return(symbol) 23 | } 24 | } 25 | -------------------------------------------------------------------------------- /R/flatten.R: -------------------------------------------------------------------------------- 1 | #' Flatten nested data frames 2 | #' 3 | #' In a nested data frame, one or more of the columns consist of another data 4 | #' frame. These structures frequently appear when parsing JSON data from the web. 5 | #' We can flatten such data frames into a regular 2 dimensional tabular structure. 6 | #' 7 | #' @export 8 | #' @param x a data frame 9 | #' @param recursive flatten recursively 10 | #' @examples options(stringsAsFactors=FALSE) 11 | #' x <- data.frame(driver = c("Bowser", "Peach"), occupation = c("Koopa", "Princess")) 12 | #' x$vehicle <- data.frame(model = c("Piranha Prowler", "Royal Racer")) 13 | #' x$vehicle$stats <- data.frame(speed = c(55, 34), weight = c(67, 24), drift = c(35, 32)) 14 | #' str(x) 15 | #' str(flatten(x)) 16 | #' str(flatten(x, recursive = FALSE)) 17 | #' 18 | #' \dontrun{ 19 | #' data1 <- fromJSON("https://api.github.com/users/hadley/repos") 20 | #' colnames(data1) 21 | #' colnames(data1$owner) 22 | #' colnames(flatten(data1)) 23 | #' 24 | #' # or for short: 25 | #' data2 <- fromJSON("https://api.github.com/users/hadley/repos", flatten = TRUE) 26 | #' colnames(data2) 27 | #' } 28 | #' 29 | flatten <- function(x, recursive = TRUE) { 30 | stopifnot(is.data.frame(x)) 31 | nr <- nrow(x) 32 | dfcolumns <- vapply(x, is.data.frame, logical(1)) 33 | if (!any(dfcolumns)) { 34 | return(x) 35 | } 36 | x <- if (recursive) { 37 | c(x[!dfcolumns], do.call(c, lapply(x[dfcolumns], flatten))) 38 | } else { 39 | c(x[!dfcolumns], do.call(c, x[dfcolumns])) 40 | } 41 | class(x) <- "data.frame" 42 | row.names(x) <- if (!nr) character(0) else 1:nr 43 | x 44 | } 45 | 46 | #1,2,3,df1,5,6,7,df2,9 47 | -------------------------------------------------------------------------------- /R/helpfunctions.R: -------------------------------------------------------------------------------- 1 | # S4 to list object. Not quite sure if this really works in general. You probably 2 | # shouldn't use S4 instances with JSON anyway because you don't know the class 3 | # definition. 4 | 5 | S4tolist <- function(x) { 6 | structure(lapply(slotNames(x), slot, object = x), .Names = slotNames(x)) 7 | } 8 | 9 | # ENCODING TOOLS 10 | 11 | # opposite of unname: force list into named list to get key/value json encodings 12 | givename <- function(obj) { 13 | return(structure(obj, names = as.character(names(obj)))) 14 | } 15 | 16 | # trim whitespace 17 | trim <- function(x) { 18 | gsub("(^[[:space:]]+|[[:space:]]+$)", "", x) 19 | } 20 | 21 | # put double quotes around a string 22 | wrapinquotes <- function(x) { 23 | paste("\"", x, "\"", sep = "") 24 | } 25 | 26 | # DECODING TOOLS 27 | evaltext <- function(text) { 28 | return(eval(parse(text = text))) 29 | } 30 | -------------------------------------------------------------------------------- /R/is.recordlist.R: -------------------------------------------------------------------------------- 1 | #' @useDynLib jsonlite C_is_recordlist 2 | is_recordlist_c <- function(x) { 3 | .Call(C_is_recordlist, x) 4 | } 5 | 6 | is_recordlist_r <- function(x) { 7 | if (!(is.unnamedlist(x) && length(x))) { 8 | return(FALSE) 9 | } 10 | at_least_one_object = FALSE 11 | for (i in x) { 12 | if (!(is.namedlist(i) || is.null(i))) return(FALSE) 13 | if (!at_least_one_object && is.namedlist(i)) at_least_one_object <- TRUE 14 | } 15 | return(at_least_one_object) 16 | } 17 | 18 | is.recordlist <- is_recordlist_c 19 | 20 | is.namedlist <- function(x) { 21 | isTRUE(is.list(x) && !is.null(names(x))) 22 | } 23 | 24 | is.unnamedlist <- function(x) { 25 | isTRUE(is.list(x) && is.null(names(x))) 26 | } 27 | -------------------------------------------------------------------------------- /R/is.scalarlist.R: -------------------------------------------------------------------------------- 1 | is_scalarlist_r <- function(x) { 2 | if (!is.list(x)) return(FALSE) 3 | for (i in x) { 4 | if (!is.atomic(i) || length(i) > 1) return(FALSE) 5 | } 6 | return(TRUE) 7 | } 8 | 9 | #' @useDynLib jsonlite C_is_scalarlist 10 | is_scalarlist_c <- function(x) { 11 | .Call(C_is_scalarlist, x) 12 | } 13 | 14 | is.scalarlist <- is_scalarlist_c 15 | -------------------------------------------------------------------------------- /R/json_gzip.R: -------------------------------------------------------------------------------- 1 | #' Gzipped JSON 2 | #' 3 | #' Wrapper to generate and parse gzipped JSON, in order to save some disk or 4 | #' network space. This is mainly effective for larger json objects with many 5 | #' repeated keys, as is common in serialized data frames. 6 | #' 7 | #' The [as_gzjson_raw] and [parse_gzjson_raw] functions work with raw (binary) 8 | #' vectors of compressed data. To use this in a place where only text is allowed 9 | #' you can wrap the output again in [base64] as done by [as_gzjson_b64] and 10 | #' [parse_gzjson_b64]. This increases the size again with about 33%. 11 | #' 12 | #' 13 | #' @param x R data object to be converted to JSON 14 | #' @param ... passed down to [toJSON] or [fromJSON] 15 | #' @export 16 | #' @name gzjson 17 | #' @rdname gzjson 18 | #' @examples str <- as_gzjson_b64(iris[1:5,]) 19 | #' cat(str) 20 | #' parse_gzjson_b64(str) 21 | as_gzjson_raw <- function(x, ...) { 22 | json <- toJSON(x = x, ...) 23 | memCompress(json, 'gzip') 24 | } 25 | 26 | #' @export 27 | #' @rdname gzjson 28 | as_gzjson_b64 <- function(x, ...) { 29 | buf <- as_gzjson_raw(x = x, ...) 30 | base64_enc(buf) 31 | } 32 | 33 | #' @export 34 | #' @rdname gzjson 35 | #' @param buf raw vector with gzip compressed data 36 | parse_gzjson_raw <- function(buf, ...) { 37 | json <- rawToChar(memDecompress(buf, 'gzip')) 38 | fromJSON(json, ...) 39 | } 40 | 41 | #' @export 42 | #' @rdname gzjson 43 | #' @param b64 base64 encoded string containing gzipped json data 44 | parse_gzjson_b64 <- function(b64, ...) { 45 | parse_gzjson_raw(base64_dec(b64), ...) 46 | } 47 | -------------------------------------------------------------------------------- /R/list_to_vec.R: -------------------------------------------------------------------------------- 1 | list_to_vec <- function(x) { 2 | isdates <- is_datelist(x) 3 | out <- unlist(null_to_na(x), recursive = FALSE, use.names = FALSE) 4 | if (isdates && is.numeric(out)) { 5 | structure(out, class = c("POSIXct", "POSIXt")) 6 | } else { 7 | out 8 | } 9 | } 10 | -------------------------------------------------------------------------------- /R/loadpkg.R: -------------------------------------------------------------------------------- 1 | loadpkg <- function(pkg) { 2 | tryCatch(getNamespace(pkg), error = function(e) { 3 | stop("Required package ", pkg, " not found. Please run: install.packages('", pkg, "')", call. = FALSE) 4 | }) 5 | } 6 | -------------------------------------------------------------------------------- /R/makesymbol.R: -------------------------------------------------------------------------------- 1 | # Note: 'symbol' is the same thing as 'name' For some reason, as.name('') gives 2 | # an error, even though it is needed sometimes. This is a workaround 3 | makesymbol <- function(x) { 4 | if (missing(x) || nchar(x) == 0) { 5 | return(substitute()) 6 | } else { 7 | as.name(x) 8 | } 9 | } 10 | -------------------------------------------------------------------------------- /R/null_to_na.R: -------------------------------------------------------------------------------- 1 | #' @useDynLib jsonlite C_null_to_na 2 | null_to_na <- function(x) { 3 | .Call(C_null_to_na, x) 4 | } 5 | 6 | #' @useDynLib jsonlite C_is_datelist 7 | is_datelist <- function(x) { 8 | .Call(C_is_datelist, x) 9 | } 10 | -------------------------------------------------------------------------------- /R/num_to_char.R: -------------------------------------------------------------------------------- 1 | #' @useDynLib jsonlite R_num_to_char 2 | num_to_char <- function(x, digits = NA, na_as_string = NA, use_signif = FALSE, always_decimal = FALSE) { 3 | if (is.na(digits)) digits <- NA_integer_ 4 | stopifnot(is.numeric(x)) 5 | stopifnot(is.numeric(digits)) 6 | stopifnot(is.logical(na_as_string)) 7 | .Call(R_num_to_char, x, digits, na_as_string, use_signif, always_decimal) 8 | } 9 | 10 | #' @useDynLib jsonlite R_integer64_to_char 11 | integer64_to_char <- function(x, na_as_string = TRUE) { 12 | .Call(R_integer64_to_char, x, na_as_string) 13 | } 14 | 15 | num_to_char_R <- function(x, digits = NA, na_as_string = NA) { 16 | if (is.na(digits)) digits <- NA_integer_ 17 | stopifnot(is.numeric(x)) 18 | stopifnot(is.numeric(digits)) 19 | stopifnot(is.logical(na_as_string)) 20 | if (!is.integer(x) && !is.null(digits) && !is.na(digits)) { 21 | x <- round(x, digits) 22 | } 23 | 24 | #convert to strings 25 | tmp <- as.character(x) 26 | 27 | # in numeric variables, NA, NaN, Inf are replaced by character strings 28 | if (any(missings <- which(!is.finite(x)))) { 29 | if (is.na(na_as_string)) { 30 | tmp[missings] <- NA_character_ 31 | } else if (na_as_string) { 32 | tmp[missings] <- wrapinquotes(x[missings]) 33 | } else { 34 | tmp[missings] <- "null" 35 | } 36 | } 37 | 38 | #returns a character vector 39 | return(tmp) 40 | } 41 | -------------------------------------------------------------------------------- /R/parseJSON.R: -------------------------------------------------------------------------------- 1 | parseJSON <- function(txt, bigint_as_char = FALSE) { 2 | if (inherits(txt, "connection")) { 3 | parse_con(txt, bigint_as_char) 4 | } else { 5 | parse_string(txt, bigint_as_char) 6 | } 7 | } 8 | 9 | #' @useDynLib jsonlite R_parse 10 | parse_string <- function(txt, bigint_as_char) { 11 | if (length(txt) > 1) { 12 | txt <- paste(txt, collapse = "\n") 13 | } 14 | .Call(R_parse, txt, bigint_as_char) 15 | } 16 | -------------------------------------------------------------------------------- /R/prettify.R: -------------------------------------------------------------------------------- 1 | #' Prettify adds indentation to a JSON string; minify removes all indentation/whitespace. 2 | #' 3 | #' @rdname prettify 4 | #' @title Prettify or minify a JSON string 5 | #' @name prettify, minify 6 | #' @aliases minify prettify 7 | #' @export prettify minify 8 | #' @param txt JSON string 9 | #' @param indent number of spaces to indent. Use a negative number for tabs instead of spaces. 10 | #' @useDynLib jsonlite R_reformat 11 | #' @examples myjson <- toJSON(cars) 12 | #' cat(myjson) 13 | #' prettify(myjson) 14 | #' minify(myjson) 15 | prettify <- function(txt, indent = 4) { 16 | stopifnot(is.numeric(indent)) 17 | txt <- paste(txt, collapse = "\n") 18 | indent_char <- ifelse(indent > 0, " ", "\t") 19 | indent_string <- paste(rep(indent_char, as.integer(abs(indent))), collapse = "") 20 | reformat(txt, TRUE, indent_string) 21 | } 22 | 23 | #' @rdname prettify 24 | minify <- function(txt) { 25 | txt <- paste(txt, collapse = "\n") 26 | reformat(txt, FALSE) 27 | } 28 | 29 | reformat <- function(x, pretty, indent_string = "") { 30 | out <- .Call(R_reformat, x, pretty, indent_string = indent_string) 31 | if (out[[1]] == 0) { 32 | return(out[[2]]) 33 | } else { 34 | stop(out[[2]], call. = FALSE) 35 | } 36 | } 37 | -------------------------------------------------------------------------------- /R/print.R: -------------------------------------------------------------------------------- 1 | #' @method print json 2 | #' @export 3 | print.json <- function(x, ...) { 4 | cat(x, "\n") 5 | } 6 | 7 | #' @method print scalar 8 | #' @export 9 | print.scalar <- function(x, ...) { 10 | original <- x 11 | class(x) <- class(x)[-1] 12 | if (is.data.frame(x)) { 13 | row.names(x) <- "[x]" 14 | print(x) 15 | } else { 16 | cat("[x] ", asJSON(x, collapse = FALSE), "\n", sep = "") 17 | } 18 | invisible(original) 19 | } 20 | -------------------------------------------------------------------------------- /R/push_parser.R: -------------------------------------------------------------------------------- 1 | #' @useDynLib jsonlite R_parse_connection 2 | parse_con <- function(con, bigint_as_char) { 3 | stopifnot(inherits(con, "connection")) 4 | if (!isOpen(con)) { 5 | on.exit(close(con)) # also destroy con if 'open' fails 6 | open(con, "rb") 7 | } 8 | .Call(R_parse_connection, con, bigint_as_char) 9 | } 10 | -------------------------------------------------------------------------------- /R/raw_to_json.R: -------------------------------------------------------------------------------- 1 | # This function deals with some uncertainty in character encoding when reading 2 | # from files and URLs. It tries UTF8 first, but falls back on native if it is 3 | # certainly not UTF8. 4 | raw_to_json <- function(x) { 5 | txt <- rawToChar(x) 6 | Encoding(txt) <- "UTF-8" 7 | isvalid <- validate(txt) 8 | if (!isvalid && grepl("invalid bytes in UTF8", attr(isvalid, "err"), fixed = TRUE, useBytes = TRUE)) { 9 | warning("The json string is not valid UTF-8. Assuming native encoding.", call. = FALSE) 10 | Encoding(txt) <- "" 11 | } 12 | return(txt) 13 | } 14 | -------------------------------------------------------------------------------- /R/rbind_pages.R: -------------------------------------------------------------------------------- 1 | #' Combine pages into a single data frame 2 | #' 3 | #' The `rbind_pages` function is used to combine a list of data frames into a single 4 | #' data frame. This is often needed when working with a JSON API that limits the amount 5 | #' of data per request. If we need more data than what fits in a single request, we need to 6 | #' perform multiple requests that each retrieve a fragment of data, not unlike pages in a 7 | #' book. In practice this is often implemented using a `page` parameter in the API. The 8 | #' `rbind_pages` function can be used to combine these pages back into a single dataset. 9 | #' 10 | #' The `rbind_pages` function uses [vctrs::vec_rbind()] 11 | #' to bind the pages together. This generalizes [`base::rbind()`][base::cbind] in two 12 | #' ways: 13 | #' 14 | #' - Not each column has to be present in each of the individual data frames; missing 15 | #' columns will be filled up in `NA` values. 16 | #' - Data frames can be nested (can contain other data frames). 17 | #' 18 | #' @export 19 | #' @param pages a list of data frames, each representing a *page* of data 20 | #' @examples # Basic example 21 | #' x <- data.frame(foo = rnorm(3), bar = c(TRUE, FALSE, TRUE)) 22 | #' y <- data.frame(foo = rnorm(2), col = c("blue", "red")) 23 | #' rbind_pages(list(x, y)) 24 | #' 25 | #' \donttest{ 26 | #' baseurl <- "https://projects.propublica.org/nonprofits/api/v2/search.json" 27 | #' pages <- list() 28 | #' for(i in 0:20){ 29 | #' mydata <- fromJSON(paste0(baseurl, "?order=revenue&sort_order=desc&page=", i)) 30 | #' message("Retrieving page ", i) 31 | #' pages[[i+1]] <- mydata$organizations 32 | #' } 33 | #' organizations <- rbind_pages(pages) 34 | #' nrow(organizations) 35 | #' colnames(organizations) 36 | #' } 37 | rbind_pages <- function(pages) { 38 | loadpkg("vctrs") 39 | 40 | #validate input 41 | stopifnot(is.list(pages)) 42 | 43 | # All elements must be data frames or NULL. 44 | pages <- Filter( 45 | function(x) { 46 | !is.null(x) 47 | }, 48 | pages 49 | ) 50 | stopifnot(all(vapply(pages, is.data.frame, logical(1)))) 51 | 52 | do.call(vctrs::vec_rbind, pages) 53 | } 54 | -------------------------------------------------------------------------------- /R/read_json.R: -------------------------------------------------------------------------------- 1 | #' Read/write JSON 2 | #' 3 | #' These functions are similar to [toJSON()] and [fromJSON()] except they 4 | #' explicitly distinguish between path and literal input, and do not simplify 5 | #' by default. 6 | #' 7 | #' @export 8 | #' @rdname read_json 9 | #' @param path file on disk 10 | #' @param simplifyVector simplifies nested lists into vectors and data frames. See [fromJSON()]. 11 | #' @seealso [fromJSON()], [stream_in()] 12 | #' @examples tmp <- tempfile() 13 | #' write_json(iris, tmp) 14 | #' 15 | #' # Nested lists 16 | #' read_json(tmp) 17 | #' 18 | #' # A data frame 19 | #' read_json(tmp, simplifyVector = TRUE) 20 | read_json <- function(path, simplifyVector = FALSE, ...) { 21 | parse_json(file(path), simplifyVector = simplifyVector, ...) 22 | } 23 | 24 | #' @export 25 | #' @rdname read_json 26 | #' @param json string with literal json or connection object to read from 27 | parse_json <- function(json, simplifyVector = FALSE, ...) { 28 | parse_and_simplify(json, simplifyVector = simplifyVector, ...) 29 | } 30 | 31 | #' @export 32 | #' @rdname read_json 33 | #' @param x an object to be serialized to JSON 34 | #' @param ... additional conversion arguments, see also [toJSON()] or [fromJSON()] 35 | write_json <- function(x, path, ...) { 36 | json <- jsonlite::toJSON(x, ...) 37 | writeLines(json, path, useBytes = TRUE) 38 | } 39 | -------------------------------------------------------------------------------- /R/serializeJSON.R: -------------------------------------------------------------------------------- 1 | #' The [serializeJSON()] and [unserializeJSON()] functions convert between 2 | #' \R{} objects to JSON data. Instead of using a class based mapping like 3 | #' [toJSON()] and [fromJSON()], the serialize functions base the encoding 4 | #' schema on the storage type, and capture all data and attributes from any object. 5 | #' Thereby the object can be restored almost perfectly from its JSON representation, but 6 | #' the resulting JSON output is very verbose. Apart from environments, all standard storage 7 | #' types are supported. 8 | #' 9 | #' @rdname serializeJSON 10 | #' @title serialize R objects to JSON 11 | #' @name serializeJSON 12 | #' @export serializeJSON unserializeJSON 13 | #' @param x an \R{} object to be serialized 14 | #' @param digits max number of digits (after the dot) to print for numeric values 15 | #' @param pretty add indentation/whitespace to JSON output. See [prettify()] 16 | #' @note JSON is a text based format which leads to loss of precision when printing numbers. 17 | #' @examples jsoncars <- serializeJSON(mtcars) 18 | #' mtcars2 <- unserializeJSON(jsoncars) 19 | #' identical(mtcars, mtcars2) 20 | #' 21 | #' set.seed('123') 22 | #' myobject <- list( 23 | #' mynull = NULL, 24 | #' mycomplex = lapply(eigen(matrix(-rnorm(9),3)), round, 3), 25 | #' mymatrix = round(matrix(rnorm(9), 3),3), 26 | #' myint = as.integer(c(1,2,3)), 27 | #' mydf = cars, 28 | #' mylist = list(foo='bar', 123, NA, NULL, list('test')), 29 | #' mylogical = c(TRUE,FALSE,NA), 30 | #' mychar = c('foo', NA, 'bar'), 31 | #' somemissings = c(1,2,NA,NaN,5, Inf, 7 -Inf, 9, NA), 32 | #' myrawvec = charToRaw('This is a test') 33 | #' ); 34 | #' identical(unserializeJSON(serializeJSON(myobject)), myobject); 35 | serializeJSON <- function(x, digits = 8, pretty = FALSE) { 36 | # just to verify that obj exists 37 | is(x) 38 | 39 | # we pass arguments both to asJSON as well as packaging object. 40 | indent <- indent_init(pretty) 41 | ans <- asJSON(pack(x), digits = digits, indent = indent) 42 | class(ans) <- "json" 43 | return(ans) 44 | } 45 | 46 | #' @param txt a JSON string which was created using `serializeJSON` 47 | #' @rdname serializeJSON 48 | unserializeJSON <- function(txt) { 49 | unpack(parseJSON(txt)) 50 | } 51 | -------------------------------------------------------------------------------- /R/simplifyDataFrame.R: -------------------------------------------------------------------------------- 1 | simplifyDataFrame <- function(recordlist, columns, flatten, simplifyMatrix) { 2 | # no records at all 3 | if (!length(recordlist)) { 4 | if (!missing(columns)) { 5 | return(as.data.frame(matrix(ncol = length(columns), nrow = 0, dimnames = list(NULL, columns)))) 6 | } else { 7 | return(data.frame()) 8 | } 9 | } 10 | 11 | # only empty records and unknown columns 12 | if (!any(vapply(recordlist, length, integer(1), USE.NAMES = FALSE)) && missing(columns)) { 13 | return(data.frame(matrix(nrow = length(recordlist), ncol = 0))) 14 | } 15 | 16 | # find columns if not specified 17 | if (missing(columns)) { 18 | columns <- unique(unlist(lapply(recordlist, names), recursive = FALSE, use.names = FALSE)) 19 | } 20 | 21 | # Convert row lists to column lists. This is the heavy lifting 22 | # columnlist <- lapply(columns, function(x) lapply(recordlist, "[[", x)) 23 | # Now slighlty optimized 24 | columnlist <- transpose_list(recordlist, columns) 25 | 26 | # simplify vectors and nested data frames 27 | columnlist <- lapply(columnlist, simplify, simplifyVector = TRUE, simplifyDataFrame = TRUE, simplifyMatrix = FALSE, simplifySubMatrix = simplifyMatrix, flatten = flatten) 28 | 29 | # check that all elements have equal length 30 | columnlengths <- unlist(vapply( 31 | columnlist, 32 | function(z) { 33 | ifelse(length(dim(z)) > 1, nrow(z), length(z)) 34 | }, 35 | integer(1) 36 | )) 37 | n <- unique(columnlengths) 38 | if (length(n) > 1) { 39 | stop("Elements not of equal length: ", paste(columnlengths, collapse = " ")) 40 | } 41 | 42 | # add the column names before flattening 43 | names(columnlist) <- columns 44 | 45 | # flatten nested data frames 46 | if (isTRUE(flatten)) { 47 | dfcolumns <- vapply(columnlist, is.data.frame, logical(1)) 48 | if (any(dfcolumns)) { 49 | columnlist <- c(columnlist[!dfcolumns], do.call(c, columnlist[dfcolumns])) 50 | } 51 | } 52 | 53 | # make into data frame 54 | class(columnlist) <- "data.frame" 55 | 56 | # set row names 57 | if ("_row" %in% names(columnlist)) { 58 | rn <- columnlist[["_row"]] 59 | columnlist["_row"] <- NULL 60 | 61 | # row.names() casts double to character which is undesired. 62 | if (is.double(rn)) { 63 | rn <- as.integer(rn) 64 | } 65 | 66 | # Replace missing values with numbers 67 | rn_na <- is.na(rn) 68 | if (sum(rn_na) > 0) { 69 | rn[rn_na] <- paste0("NA_", seq_len(sum(rn_na))) 70 | } 71 | 72 | # data frames MUST have row names 73 | if (any(duplicated(rn))) { 74 | warning('Duplicate names in "_row" field. Data frames must have unique row names.', call. = FALSE) 75 | if (is.character(rn)) { 76 | row.names(columnlist) <- make.unique(rn) 77 | } else { 78 | row.names(columnlist) <- seq_len(n) 79 | } 80 | } else { 81 | row.names(columnlist) <- rn 82 | } 83 | } else { 84 | row.names(columnlist) <- seq_len(n) 85 | } 86 | 87 | return(columnlist) 88 | } 89 | -------------------------------------------------------------------------------- /R/stop.R: -------------------------------------------------------------------------------- 1 | stop <- function(..., call. = FALSE) { 2 | base::stop(..., call. = FALSE) 3 | } 4 | -------------------------------------------------------------------------------- /R/toJSON.R: -------------------------------------------------------------------------------- 1 | #' @rdname fromJSON 2 | toJSON <- function( 3 | x, 4 | dataframe = c("rows", "columns", "values"), 5 | matrix = c("rowmajor", "columnmajor"), 6 | Date = c("ISO8601", "epoch"), 7 | POSIXt = c("string", "ISO8601", "epoch", "mongo"), 8 | factor = c("string", "integer"), 9 | complex = c("string", "list"), 10 | raw = c("base64", "hex", "mongo", "int", "js"), 11 | null = c("list", "null"), 12 | na = c("null", "string"), 13 | auto_unbox = FALSE, 14 | digits = 4, 15 | pretty = FALSE, 16 | force = FALSE, 17 | ... 18 | ) { 19 | # validate args 20 | dataframe <- match.arg(dataframe) 21 | matrix <- match.arg(matrix) 22 | Date <- match.arg(Date) 23 | POSIXt <- match.arg(POSIXt) 24 | factor <- match.arg(factor) 25 | complex <- match.arg(complex) 26 | raw <- match.arg(raw) 27 | null <- match.arg(null) 28 | 29 | # Temp workaround for 'mongopipe' unit test 30 | # if (pretty == 2 && identical(x, list()) && identical(Sys.getenv('TESTTHAT_PKG'), 'mongopipe')) { 31 | # return('[\n\n]') 32 | # } 33 | 34 | # force 35 | x <- force(x) 36 | 37 | #this is just to check, we keep method-specific defaults 38 | if (!missing(na)) { 39 | na <- match.arg(na) 40 | } else { 41 | na <- NULL 42 | } 43 | 44 | # dispatch 45 | indent <- indent_init(pretty) 46 | ans <- asJSON(x, dataframe = dataframe, Date = Date, POSIXt = POSIXt, factor = factor, complex = complex, raw = raw, matrix = matrix, auto_unbox = auto_unbox, digits = digits, na = na, null = null, force = force, indent = indent, ...) 47 | class(ans) <- "json" 48 | return(ans) 49 | } 50 | 51 | indent_init <- function(pretty) { 52 | # default is 2 spaces 53 | if (isTRUE(pretty)) { 54 | pretty <- 2L 55 | } 56 | 57 | # Start with indent of 0 58 | if (is.numeric(pretty)) { 59 | stopifnot(abs(pretty) < 20) 60 | structure(0L, indent_spaces = as.integer(pretty)) 61 | } else { 62 | NA_integer_ 63 | } 64 | } 65 | 66 | indent_increment <- function(indent) { 67 | indent_spaces <- attr(indent, 'indent_spaces') 68 | if (length(indent_spaces)) { 69 | indent + abs(indent_spaces) 70 | } else { 71 | NA_integer_ 72 | } 73 | } 74 | -------------------------------------------------------------------------------- /R/transpose_list.R: -------------------------------------------------------------------------------- 1 | #' @useDynLib jsonlite C_transpose_list 2 | transpose_list <- function(x, names) { 3 | .Call(C_transpose_list, x, names) 4 | } 5 | -------------------------------------------------------------------------------- /R/unbox.R: -------------------------------------------------------------------------------- 1 | #' Unbox a vector or data frame 2 | #' 3 | #' This function marks an atomic vector or data frame as a 4 | #' [singleton](https://en.wikipedia.org/wiki/Singleton_(mathematics)), i.e. 5 | #' a set with exactly 1 element. Thereby, the value will not turn into an 6 | #' `array` when encoded into JSON. This can only be done for 7 | #' atomic vectors of length 1, or data frames with exactly 1 row. To automatically 8 | #' unbox all vectors of length 1 within an object, use the `auto_unbox` argument 9 | #' in [toJSON()]. 10 | #' 11 | #' It is usually recommended to avoid this function and stick with the default 12 | #' encoding schema for the various \R{} classes. The only use case for this function 13 | #' is if you are bound to some specific predefined JSON structure (e.g. to 14 | #' submit to an API), which has no natural \R{} representation. Note that the default 15 | #' encoding for data frames naturally results in a collection of key-value pairs, 16 | #' without using `unbox`. 17 | #' 18 | #' @param x atomic vector of length 1, or data frame with 1 row. 19 | #' @return Returns a singleton version of `x`. 20 | #' @export 21 | #' @references 22 | #' @examples toJSON(list(foo=123)) 23 | #' toJSON(list(foo=unbox(123))) 24 | #' 25 | #' # Auto unbox vectors of length one: 26 | #' x = list(x=1:3, y = 4, z = "foo", k = NULL) 27 | #' toJSON(x) 28 | #' toJSON(x, auto_unbox = TRUE) 29 | #' 30 | #' x <- iris[1,] 31 | #' toJSON(list(rec=x)) 32 | #' toJSON(list(rec=unbox(x))) 33 | unbox <- function(x) { 34 | if (is.null(x)) { 35 | return(x) 36 | } 37 | if (is.data.frame(x)) { 38 | if (nrow(x) == 1) { 39 | return(as.scalar(x)) 40 | } else { 41 | stop("Tried to unbox dataframe with ", nrow(x), " rows.") 42 | } 43 | } 44 | if (length(x) == 1L && inherits(x, "POSIXt")) { 45 | return(as.scalar(x)) 46 | } 47 | if (is.null(x) || !is.atomic(x) || length(dim(x)) > 1) { 48 | stop("Only atomic vectors of length 1 or data frames with 1 row can be unboxed.") 49 | } 50 | if (identical(length(x), 1L)) { 51 | return(as.scalar(x)) 52 | } else { 53 | stop("Tried to unbox a vector of length ", length(x)) 54 | } 55 | } 56 | -------------------------------------------------------------------------------- /R/unescape_unicode.R: -------------------------------------------------------------------------------- 1 | unescape_unicode <- function(x) { 2 | #single string only 3 | stopifnot(is.character(x) && length(x) == 1) 4 | 5 | #find matches 6 | m <- gregexpr("(\\\\)+u[0-9a-z]{4}", x, ignore.case = TRUE) 7 | 8 | if (m[[1]][1] > -1) { 9 | #parse matches 10 | p <- vapply( 11 | regmatches(x, m)[[1]], 12 | function(txt) { 13 | gsub("\\", "\\\\", parse(text = paste0('"', txt, '"'))[[1]], fixed = TRUE, useBytes = TRUE) 14 | }, 15 | character(1), 16 | USE.NAMES = FALSE 17 | ) 18 | 19 | #substitute parsed into original 20 | regmatches(x, m) <- list(p) 21 | } 22 | 23 | x 24 | } 25 | -------------------------------------------------------------------------------- /R/utf8conv.R: -------------------------------------------------------------------------------- 1 | utf8conv <- function(x) { 2 | gsub("", "\\\\u\\1", x) 3 | } 4 | -------------------------------------------------------------------------------- /R/validate.R: -------------------------------------------------------------------------------- 1 | #' Validate JSON 2 | #' 3 | #' Test if a string contains valid JSON. Characters vectors will be collapsed into a single string. 4 | #' 5 | #' @param txt JSON string 6 | #' @export 7 | #' @useDynLib jsonlite R_validate 8 | #' @examples #Output from toJSON and serializeJSON should pass validation 9 | #' myjson <- toJSON(mtcars) 10 | #' validate(myjson) #TRUE 11 | #' 12 | #' #Something bad happened 13 | #' truncated <- substring(myjson, 1, 100) 14 | #' validate(truncated) #FALSE 15 | validate <- function(txt) { 16 | stopifnot(is.character(txt)) 17 | txt <- paste(txt, collapse = "\n") 18 | .Call(R_validate, as.character(txt)) 19 | } 20 | -------------------------------------------------------------------------------- /R/warn_keep_vec_names.R: -------------------------------------------------------------------------------- 1 | warn_keep_vec_names <- function() { 2 | message("Input to asJSON(keep_vec_names=TRUE) is a named vector. ", "In a future version of jsonlite, this option will not be supported, ", "and named vectors will be translated into arrays instead of objects. ", "If you want JSON object output, please use a named list instead. See ?toJSON.") 3 | } 4 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # jsonlite 2 | 3 | > A Robust, High Performance JSON Parser and Generator for R 4 | 5 | [![CRAN_Status_Badge](https://www.r-pkg.org/badges/version/jsonlite)](http://cran.r-project.org/package=jsonlite) 6 | [![CRAN RStudio mirror downloads](https://cranlogs.r-pkg.org/badges/jsonlite)](http://cran.r-project.org/web/packages/jsonlite/index.html) 7 | 8 | A reasonably fast JSON parser and generator, optimized for statistical 9 | data and the web. Offers simple, flexible tools for working with JSON in R, and 10 | is particularly powerful for building pipelines and interacting with a web API. 11 | The implementation is based on the mapping described in the vignette (Ooms, 2014). 12 | In addition to converting JSON data from/to R objects, 'jsonlite' contains 13 | functions to stream, validate, and prettify JSON data. The unit tests included 14 | with the package verify that all edge cases are encoded and decoded consistently 15 | for use with dynamic data in systems and applications. 16 | 17 | Have a look at the [quickstart vignette](https://jeroen.r-universe.dev/articles/jsonlite/json-aaquickstart.html) to get started! 18 | 19 | ## Code of Conduct 20 | 21 | Please note that the jsonlite project is released with a [Contributor Code of Conduct](https://www.contributor-covenant.org/version/2/1/code_of_conduct/). By contributing to this project, you agree to abide by its terms. 22 | -------------------------------------------------------------------------------- /air.toml: -------------------------------------------------------------------------------- 1 | [format] 2 | line-width = 320 3 | 4 | -------------------------------------------------------------------------------- /inst/CITATION: -------------------------------------------------------------------------------- 1 | citHeader("To cite jsonlite in publications use:") 2 | 3 | bibentry("Article", 4 | title = "The jsonlite Package: A Practical and Consistent Mapping Between JSON Data and R Objects", 5 | author = person("Jeroen", "Ooms"), 6 | journal = "arXiv:1403.2805 [stat.CO]", 7 | year = "2014", 8 | url = "https://arxiv.org/abs/1403.2805" 9 | ) 10 | -------------------------------------------------------------------------------- /jsonlite.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | ProjectId: 5dbf6309-ffcd-4053-9d49-582aca2016b8 3 | 4 | RestoreWorkspace: Default 5 | SaveWorkspace: Default 6 | AlwaysSaveHistory: Default 7 | 8 | EnableCodeIndexing: Yes 9 | UseSpacesForTab: Yes 10 | NumSpacesForTab: 2 11 | Encoding: UTF-8 12 | 13 | RnwWeave: knitr 14 | LaTeX: pdfLaTeX 15 | 16 | AutoAppendNewline: Yes 17 | StripTrailingWhitespace: Yes 18 | 19 | BuildType: Package 20 | PackageInstallArgs: --no-multiarch --with-keep.source --install-tests 21 | -------------------------------------------------------------------------------- /man/base64.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/base64.R 3 | \name{base64} 4 | \alias{base64} 5 | \alias{base64_dec} 6 | \alias{base64_enc} 7 | \alias{base64url_enc} 8 | \alias{base64url_dec} 9 | \title{Encode/decode base64} 10 | \usage{ 11 | base64_dec(input) 12 | 13 | base64_enc(input) 14 | 15 | base64url_enc(input) 16 | 17 | base64url_dec(input) 18 | } 19 | \arguments{ 20 | \item{input}{string or raw vector to be encoded/decoded} 21 | } 22 | \description{ 23 | Simple in-memory base64 encoder and decoder. Used internally for converting 24 | raw vectors to text. Interchangeable with encoder from \code{base64enc} or 25 | \code{openssl} package. 26 | } 27 | \details{ 28 | The \link{base64url_enc} and \link{base64url_dec} functions use a variation of base64 29 | that substitute characters \verb{+/} for \verb{-_} respectively, such that the output 30 | does not require URL-encoding. See also section 5 of rfc4648. 31 | } 32 | \examples{ 33 | str <- base64_enc(serialize(iris, NULL)) 34 | out <- unserialize(base64_dec(str)) 35 | stopifnot(identical(out, iris)) 36 | } 37 | -------------------------------------------------------------------------------- /man/flatten.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/flatten.R 3 | \name{flatten} 4 | \alias{flatten} 5 | \title{Flatten nested data frames} 6 | \usage{ 7 | flatten(x, recursive = TRUE) 8 | } 9 | \arguments{ 10 | \item{x}{a data frame} 11 | 12 | \item{recursive}{flatten recursively} 13 | } 14 | \description{ 15 | In a nested data frame, one or more of the columns consist of another data 16 | frame. These structures frequently appear when parsing JSON data from the web. 17 | We can flatten such data frames into a regular 2 dimensional tabular structure. 18 | } 19 | \examples{ 20 | options(stringsAsFactors=FALSE) 21 | x <- data.frame(driver = c("Bowser", "Peach"), occupation = c("Koopa", "Princess")) 22 | x$vehicle <- data.frame(model = c("Piranha Prowler", "Royal Racer")) 23 | x$vehicle$stats <- data.frame(speed = c(55, 34), weight = c(67, 24), drift = c(35, 32)) 24 | str(x) 25 | str(flatten(x)) 26 | str(flatten(x, recursive = FALSE)) 27 | 28 | \dontrun{ 29 | data1 <- fromJSON("https://api.github.com/users/hadley/repos") 30 | colnames(data1) 31 | colnames(data1$owner) 32 | colnames(flatten(data1)) 33 | 34 | # or for short: 35 | data2 <- fromJSON("https://api.github.com/users/hadley/repos", flatten = TRUE) 36 | colnames(data2) 37 | } 38 | 39 | } 40 | -------------------------------------------------------------------------------- /man/gzjson.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/json_gzip.R 3 | \name{gzjson} 4 | \alias{gzjson} 5 | \alias{as_gzjson_raw} 6 | \alias{as_gzjson_b64} 7 | \alias{parse_gzjson_raw} 8 | \alias{parse_gzjson_b64} 9 | \title{Gzipped JSON} 10 | \usage{ 11 | as_gzjson_raw(x, ...) 12 | 13 | as_gzjson_b64(x, ...) 14 | 15 | parse_gzjson_raw(buf, ...) 16 | 17 | parse_gzjson_b64(b64, ...) 18 | } 19 | \arguments{ 20 | \item{x}{R data object to be converted to JSON} 21 | 22 | \item{...}{passed down to \link{toJSON} or \link{fromJSON}} 23 | 24 | \item{buf}{raw vector with gzip compressed data} 25 | 26 | \item{b64}{base64 encoded string containing gzipped json data} 27 | } 28 | \description{ 29 | Wrapper to generate and parse gzipped JSON, in order to save some disk or 30 | network space. This is mainly effective for larger json objects with many 31 | repeated keys, as is common in serialized data frames. 32 | } 33 | \details{ 34 | The \link{as_gzjson_raw} and \link{parse_gzjson_raw} functions work with raw (binary) 35 | vectors of compressed data. To use this in a place where only text is allowed 36 | you can wrap the output again in \link{base64} as done by \link{as_gzjson_b64} and 37 | \link{parse_gzjson_b64}. This increases the size again with about 33\%. 38 | } 39 | \examples{ 40 | str <- as_gzjson_b64(iris[1:5,]) 41 | cat(str) 42 | parse_gzjson_b64(str) 43 | } 44 | -------------------------------------------------------------------------------- /man/prettify.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/prettify.R 3 | \name{prettify, minify} 4 | \alias{prettify, minify} 5 | \alias{prettify} 6 | \alias{minify} 7 | \title{Prettify or minify a JSON string} 8 | \usage{ 9 | prettify(txt, indent = 4) 10 | 11 | minify(txt) 12 | } 13 | \arguments{ 14 | \item{txt}{JSON string} 15 | 16 | \item{indent}{number of spaces to indent. Use a negative number for tabs instead of spaces.} 17 | } 18 | \description{ 19 | Prettify adds indentation to a JSON string; minify removes all indentation/whitespace. 20 | } 21 | \examples{ 22 | myjson <- toJSON(cars) 23 | cat(myjson) 24 | prettify(myjson) 25 | minify(myjson) 26 | } 27 | -------------------------------------------------------------------------------- /man/rbind_pages.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/rbind_pages.R 3 | \name{rbind_pages} 4 | \alias{rbind_pages} 5 | \title{Combine pages into a single data frame} 6 | \usage{ 7 | rbind_pages(pages) 8 | } 9 | \arguments{ 10 | \item{pages}{a list of data frames, each representing a \emph{page} of data} 11 | } 12 | \description{ 13 | The \code{rbind_pages} function is used to combine a list of data frames into a single 14 | data frame. This is often needed when working with a JSON API that limits the amount 15 | of data per request. If we need more data than what fits in a single request, we need to 16 | perform multiple requests that each retrieve a fragment of data, not unlike pages in a 17 | book. In practice this is often implemented using a \code{page} parameter in the API. The 18 | \code{rbind_pages} function can be used to combine these pages back into a single dataset. 19 | } 20 | \details{ 21 | The \code{rbind_pages} function uses \code{\link[vctrs:vec_bind]{vctrs::vec_rbind()}} 22 | to bind the pages together. This generalizes \code{\link[base:cbind]{base::rbind()}} in two 23 | ways: 24 | \itemize{ 25 | \item Not each column has to be present in each of the individual data frames; missing 26 | columns will be filled up in \code{NA} values. 27 | \item Data frames can be nested (can contain other data frames). 28 | } 29 | } 30 | \examples{ 31 | # Basic example 32 | x <- data.frame(foo = rnorm(3), bar = c(TRUE, FALSE, TRUE)) 33 | y <- data.frame(foo = rnorm(2), col = c("blue", "red")) 34 | rbind_pages(list(x, y)) 35 | 36 | \donttest{ 37 | baseurl <- "https://projects.propublica.org/nonprofits/api/v2/search.json" 38 | pages <- list() 39 | for(i in 0:20){ 40 | mydata <- fromJSON(paste0(baseurl, "?order=revenue&sort_order=desc&page=", i)) 41 | message("Retrieving page ", i) 42 | pages[[i+1]] <- mydata$organizations 43 | } 44 | organizations <- rbind_pages(pages) 45 | nrow(organizations) 46 | colnames(organizations) 47 | } 48 | } 49 | -------------------------------------------------------------------------------- /man/read_json.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/read_json.R 3 | \name{read_json} 4 | \alias{read_json} 5 | \alias{parse_json} 6 | \alias{write_json} 7 | \title{Read/write JSON} 8 | \usage{ 9 | read_json(path, simplifyVector = FALSE, ...) 10 | 11 | parse_json(json, simplifyVector = FALSE, ...) 12 | 13 | write_json(x, path, ...) 14 | } 15 | \arguments{ 16 | \item{path}{file on disk} 17 | 18 | \item{simplifyVector}{simplifies nested lists into vectors and data frames. See \code{\link[=fromJSON]{fromJSON()}}.} 19 | 20 | \item{...}{additional conversion arguments, see also \code{\link[=toJSON]{toJSON()}} or \code{\link[=fromJSON]{fromJSON()}}} 21 | 22 | \item{json}{string with literal json or connection object to read from} 23 | 24 | \item{x}{an object to be serialized to JSON} 25 | } 26 | \description{ 27 | These functions are similar to \code{\link[=toJSON]{toJSON()}} and \code{\link[=fromJSON]{fromJSON()}} except they 28 | explicitly distinguish between path and literal input, and do not simplify 29 | by default. 30 | } 31 | \examples{ 32 | tmp <- tempfile() 33 | write_json(iris, tmp) 34 | 35 | # Nested lists 36 | read_json(tmp) 37 | 38 | # A data frame 39 | read_json(tmp, simplifyVector = TRUE) 40 | } 41 | \seealso{ 42 | \code{\link[=fromJSON]{fromJSON()}}, \code{\link[=stream_in]{stream_in()}} 43 | } 44 | -------------------------------------------------------------------------------- /man/serializeJSON.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/serializeJSON.R 3 | \name{serializeJSON} 4 | \alias{serializeJSON} 5 | \alias{unserializeJSON} 6 | \title{serialize R objects to JSON} 7 | \usage{ 8 | serializeJSON(x, digits = 8, pretty = FALSE) 9 | 10 | unserializeJSON(txt) 11 | } 12 | \arguments{ 13 | \item{x}{an \R{} object to be serialized} 14 | 15 | \item{digits}{max number of digits (after the dot) to print for numeric values} 16 | 17 | \item{pretty}{add indentation/whitespace to JSON output. See \code{\link[=prettify]{prettify()}}} 18 | 19 | \item{txt}{a JSON string which was created using \code{serializeJSON}} 20 | } 21 | \description{ 22 | The \code{\link[=serializeJSON]{serializeJSON()}} and \code{\link[=unserializeJSON]{unserializeJSON()}} functions convert between 23 | \R{} objects to JSON data. Instead of using a class based mapping like 24 | \code{\link[=toJSON]{toJSON()}} and \code{\link[=fromJSON]{fromJSON()}}, the serialize functions base the encoding 25 | schema on the storage type, and capture all data and attributes from any object. 26 | Thereby the object can be restored almost perfectly from its JSON representation, but 27 | the resulting JSON output is very verbose. Apart from environments, all standard storage 28 | types are supported. 29 | } 30 | \note{ 31 | JSON is a text based format which leads to loss of precision when printing numbers. 32 | } 33 | \examples{ 34 | jsoncars <- serializeJSON(mtcars) 35 | mtcars2 <- unserializeJSON(jsoncars) 36 | identical(mtcars, mtcars2) 37 | 38 | set.seed('123') 39 | myobject <- list( 40 | mynull = NULL, 41 | mycomplex = lapply(eigen(matrix(-rnorm(9),3)), round, 3), 42 | mymatrix = round(matrix(rnorm(9), 3),3), 43 | myint = as.integer(c(1,2,3)), 44 | mydf = cars, 45 | mylist = list(foo='bar', 123, NA, NULL, list('test')), 46 | mylogical = c(TRUE,FALSE,NA), 47 | mychar = c('foo', NA, 'bar'), 48 | somemissings = c(1,2,NA,NaN,5, Inf, 7 -Inf, 9, NA), 49 | myrawvec = charToRaw('This is a test') 50 | ); 51 | identical(unserializeJSON(serializeJSON(myobject)), myobject); 52 | } 53 | -------------------------------------------------------------------------------- /man/unbox.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/unbox.R 3 | \name{unbox} 4 | \alias{unbox} 5 | \title{Unbox a vector or data frame} 6 | \usage{ 7 | unbox(x) 8 | } 9 | \arguments{ 10 | \item{x}{atomic vector of length 1, or data frame with 1 row.} 11 | } 12 | \value{ 13 | Returns a singleton version of \code{x}. 14 | } 15 | \description{ 16 | This function marks an atomic vector or data frame as a 17 | \href{https://en.wikipedia.org/wiki/Singleton_(mathematics)}{singleton}, i.e. 18 | a set with exactly 1 element. Thereby, the value will not turn into an 19 | \code{array} when encoded into JSON. This can only be done for 20 | atomic vectors of length 1, or data frames with exactly 1 row. To automatically 21 | unbox all vectors of length 1 within an object, use the \code{auto_unbox} argument 22 | in \code{\link[=toJSON]{toJSON()}}. 23 | } 24 | \details{ 25 | It is usually recommended to avoid this function and stick with the default 26 | encoding schema for the various \R{} classes. The only use case for this function 27 | is if you are bound to some specific predefined JSON structure (e.g. to 28 | submit to an API), which has no natural \R{} representation. Note that the default 29 | encoding for data frames naturally results in a collection of key-value pairs, 30 | without using \code{unbox}. 31 | } 32 | \examples{ 33 | toJSON(list(foo=123)) 34 | toJSON(list(foo=unbox(123))) 35 | 36 | # Auto unbox vectors of length one: 37 | x = list(x=1:3, y = 4, z = "foo", k = NULL) 38 | toJSON(x) 39 | toJSON(x, auto_unbox = TRUE) 40 | 41 | x <- iris[1,] 42 | toJSON(list(rec=x)) 43 | toJSON(list(rec=unbox(x))) 44 | } 45 | \references{ 46 | \url{https://en.wikipedia.org/wiki/Singleton_(mathematics)} 47 | } 48 | -------------------------------------------------------------------------------- /man/validate.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/validate.R 3 | \name{validate} 4 | \alias{validate} 5 | \title{Validate JSON} 6 | \usage{ 7 | validate(txt) 8 | } 9 | \arguments{ 10 | \item{txt}{JSON string} 11 | } 12 | \description{ 13 | Test if a string contains valid JSON. Characters vectors will be collapsed into a single string. 14 | } 15 | \examples{ 16 | #Output from toJSON and serializeJSON should pass validation 17 | myjson <- toJSON(mtcars) 18 | validate(myjson) #TRUE 19 | 20 | #Something bad happened 21 | truncated <- substring(myjson, 1, 100) 22 | validate(truncated) #FALSE 23 | } 24 | -------------------------------------------------------------------------------- /paper/article.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jeroen/jsonlite/461c4166127faa881c9b953dec5431d1d57b9da8/paper/article.pdf -------------------------------------------------------------------------------- /paper/jsslogo.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jeroen/jsonlite/461c4166127faa881c9b953dec5431d1d57b9da8/paper/jsslogo.jpg -------------------------------------------------------------------------------- /src/Makevars: -------------------------------------------------------------------------------- 1 | PKG_CPPFLAGS = -Iyajl/api 2 | PKG_LIBS = -Lyajl -lstatyajl 3 | 4 | # Hack to add a windows-only flag 5 | PKG_CFLAGS = $(C_VISIBILITY) \ 6 | $(subst 64,-D__USE_MINGW_ANSI_STDIO,$(subst 32,64,$(WIN))) 7 | 8 | LIBYAJL = yajl/yajl.o yajl/yajl_alloc.o yajl/yajl_buf.o yajl/yajl_encode.o \ 9 | yajl/yajl_gen.o yajl/yajl_lex.o yajl/yajl_parser.o yajl/yajl_tree.o 10 | 11 | STATLIB = yajl/libstatyajl.a 12 | 13 | all: $(SHLIB) cleanup 14 | 15 | $(SHLIB): $(STATLIB) 16 | 17 | $(STATLIB): $(LIBYAJL) 18 | 19 | cleanup: $(SHLIB) 20 | @rm -f $(LIBYAJL) $(STATLIB) 21 | 22 | # On Windows this rule is masked by Makeconf in base R 23 | %.a: 24 | @$(AR) crs $@ $^ && $(STRIP_STATIC_LIB) $@ || true 25 | -------------------------------------------------------------------------------- /src/base64.c: -------------------------------------------------------------------------------- 1 | /* 2 | * Based off: http://src.gnu-darwin.org/src/contrib/wpa_supplicant/base64.c 3 | * BSD Licensed. 4 | */ 5 | 6 | #include 7 | #include 8 | 9 | #include "base64.h" 10 | 11 | static const unsigned char base64_table[64] = 12 | "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"; 13 | 14 | /** 15 | * base64_encode - Base64 encode 16 | * @src: Data to be encoded 17 | * @len: Length of the data to be encoded 18 | * @out_len: Pointer to output length variable, or %NULL if not used 19 | * Returns: Allocated buffer of out_len bytes of encoded data, 20 | * or %NULL on failure 21 | * 22 | * Caller is responsible for freeing the returned buffer. Returned buffer is 23 | * nul terminated to make it easier to use as a C string. The nul terminator is 24 | * not included in out_len. 25 | */ 26 | unsigned char * base64_encode(const unsigned char *src, size_t len, 27 | size_t *out_len) 28 | { 29 | unsigned char *out, *pos; 30 | const unsigned char *end, *in; 31 | size_t olen; 32 | int line_len; 33 | 34 | olen = len * 4 / 3 + 4; /* 3-byte blocks to 4-byte */ 35 | olen += olen / 72; /* line feeds */ 36 | olen++; /* nul termination */ 37 | out = malloc(olen); 38 | if (out == NULL) 39 | return NULL; 40 | 41 | end = src + len; 42 | in = src; 43 | pos = out; 44 | line_len = 0; 45 | while (end - in >= 3) { 46 | *pos++ = base64_table[in[0] >> 2]; 47 | *pos++ = base64_table[((in[0] & 0x03) << 4) | (in[1] >> 4)]; 48 | *pos++ = base64_table[((in[1] & 0x0f) << 2) | (in[2] >> 6)]; 49 | *pos++ = base64_table[in[2] & 0x3f]; 50 | in += 3; 51 | line_len += 4; 52 | if (line_len >= 72) { 53 | *pos++ = '\n'; 54 | line_len = 0; 55 | } 56 | } 57 | 58 | if (end - in) { 59 | *pos++ = base64_table[in[0] >> 2]; 60 | if (end - in == 1) { 61 | *pos++ = base64_table[(in[0] & 0x03) << 4]; 62 | *pos++ = '='; 63 | } else { 64 | *pos++ = base64_table[((in[0] & 0x03) << 4) | 65 | (in[1] >> 4)]; 66 | *pos++ = base64_table[(in[1] & 0x0f) << 2]; 67 | } 68 | *pos++ = '='; 69 | line_len += 4; 70 | } 71 | 72 | //if (line_len) 73 | // *pos++ = '\n'; 74 | 75 | *pos = '\0'; 76 | if (out_len) 77 | *out_len = pos - out; 78 | return out; 79 | } 80 | 81 | 82 | /** 83 | * base64_decode - Base64 decode 84 | * @src: Data to be decoded 85 | * @len: Length of the data to be decoded 86 | * @out_len: Pointer to output length variable 87 | * Returns: Allocated buffer of out_len bytes of decoded data, 88 | * or %NULL on failure 89 | * 90 | * Caller is responsible for freeing the returned buffer. 91 | */ 92 | unsigned char * base64_decode(const unsigned char *src, size_t len, 93 | size_t *out_len) 94 | { 95 | unsigned char dtable[256], *out, *pos, in[4], block[4], tmp; 96 | size_t i, count; 97 | 98 | memset(dtable, 0x80, 256); 99 | for (i = 0; i < sizeof(base64_table); i++) 100 | dtable[base64_table[i]] = i; 101 | dtable['='] = 0; 102 | 103 | count = 0; 104 | for (i = 0; i < len; i++) { 105 | if (dtable[src[i]] != 0x80) 106 | count++; 107 | } 108 | 109 | if (count % 4) 110 | return NULL; 111 | 112 | pos = out = malloc(count); 113 | if (out == NULL) 114 | return NULL; 115 | 116 | count = 0; 117 | for (i = 0; i < len; i++) { 118 | tmp = dtable[src[i]]; 119 | if (tmp == 0x80) 120 | continue; 121 | 122 | in[count] = src[i]; 123 | block[count] = tmp; 124 | count++; 125 | if (count == 4) { 126 | *pos++ = (block[0] << 2) | (block[1] >> 4); 127 | *pos++ = (block[1] << 4) | (block[2] >> 2); 128 | *pos++ = (block[2] << 6) | block[3]; 129 | count = 0; 130 | } 131 | } 132 | 133 | if (pos > out) { 134 | if (in[2] == '=') 135 | pos -= 2; 136 | else if (in[3] == '=') 137 | pos--; 138 | } 139 | 140 | *out_len = pos - out; 141 | return out; 142 | } 143 | -------------------------------------------------------------------------------- /src/base64.h: -------------------------------------------------------------------------------- 1 | /* 2 | * Base64 encoding/decoding (RFC1341) 3 | * Copyright (c) 2005, Jouni Malinen 4 | * 5 | * This program is free software; you can redistribute it and/or modify 6 | * it under the terms of the GNU General Public License version 2 as 7 | * published by the Free Software Foundation. 8 | * 9 | * Alternatively, this software may be distributed under the terms of BSD 10 | * license. 11 | * 12 | * See README and COPYING for more details. 13 | */ 14 | 15 | #ifndef BASE64_H 16 | #define BASE64_H 17 | 18 | unsigned char * base64_encode(const unsigned char *src, size_t len, 19 | size_t *out_len); 20 | unsigned char * base64_decode(const unsigned char *src, size_t len, 21 | size_t *out_len); 22 | 23 | #endif /* BASE64_H */ 24 | -------------------------------------------------------------------------------- /src/collapse_array.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | 5 | SEXP C_collapse_array(SEXP x) { 6 | if (!isString(x)) 7 | error("x must be a character vector."); 8 | 9 | int len = length(x); 10 | size_t nchar_total = 0; 11 | 12 | for (int i=0; i 2 | #include 3 | #include 4 | 5 | SEXP C_collapse_object(SEXP x, SEXP y) { 6 | if (!isString(x) || !isString(y)) 7 | error("x and y must character vectors."); 8 | 9 | int len = length(x); 10 | if (len != length(y)) 11 | error("x and y must same length."); 12 | 13 | size_t nchar_total = 0; 14 | 15 | for (int i=0; i 2 | #include 3 | 4 | /* 5 | Fast escaping of character vectors (Winston Chang) 6 | https://gist.github.com/wch/e3ec5b20eb712f1b22b2 7 | http://stackoverflow.com/questions/25609174/fast-escaping-deparsing-of-character-vectors-in-r/25613834#25613834 8 | */ 9 | 10 | SEXP C_escape_chars_one(SEXP x) { 11 | 12 | // Make a cursor pointer 13 | const char * cur = CHAR(x); 14 | const char * end = CHAR(x) + Rf_length(x); 15 | 16 | // Count the number of matches 17 | int matches = 0; 18 | while (cur < end) { 19 | switch(*cur) { 20 | case '\\': 21 | case '"': 22 | case '\n': 23 | case '\r': 24 | case '\t': 25 | case '\b': 26 | case '\f': 27 | matches++; 28 | break; 29 | case '/': 30 | if(cur > CHAR(x) && cur[-1] == '<') 31 | matches++; 32 | break; 33 | default: 34 | if (*cur >= 0x00 && *cur <= 0x1f) 35 | matches += 5; //needs explicit \u00xx escaping 36 | } 37 | cur++; 38 | } 39 | 40 | // Calculate output length, 2 for double quotes 41 | size_t outlen = Rf_length(x) + matches + 2; 42 | char * newstr = malloc(outlen); 43 | 44 | // Reset cursor to beginning 45 | cur = CHAR(x); 46 | 47 | // Allocate string memory; add 2 for start and end quotes. 48 | char * outcur = newstr; 49 | *outcur++ = '"'; 50 | 51 | while(cur < end) { 52 | switch(*cur) { 53 | case '\\': 54 | *outcur++ = '\\'; 55 | *outcur = '\\'; 56 | break; 57 | case '"': 58 | *outcur++ = '\\'; 59 | *outcur = '"'; 60 | break; 61 | case '\n': 62 | *outcur++ = '\\'; 63 | *outcur = 'n'; 64 | break; 65 | case '\r': 66 | *outcur++ = '\\'; 67 | *outcur = 'r'; 68 | break; 69 | case '\t': 70 | *outcur++ = '\\'; 71 | *outcur = 't'; 72 | break; 73 | case '\b': 74 | *outcur++ = '\\'; 75 | *outcur = 'b'; 76 | break; 77 | case '\f': 78 | *outcur++ = '\\'; 79 | *outcur = 'f'; 80 | break; 81 | case '/': 82 | if(cur > CHAR(x) && cur[-1] == '<'){ 83 | *outcur++ = '\\'; 84 | *outcur = '/'; 85 | break; 86 | } //FALL THROUGH! 87 | default: 88 | //control characters need explicit \u00xx escaping 89 | if (*cur >= 0x00 && *cur <= 0x1f){ 90 | snprintf(outcur, 7, "\\u%04x", *cur); 91 | outcur += 5; //extra length 92 | break; 93 | } 94 | //simply copy char from input 95 | *outcur = *cur; 96 | } 97 | 98 | //increment input and output cursors to next character 99 | cur++; 100 | outcur++; 101 | } 102 | 103 | //Close quote and create R string 104 | *outcur = '"'; 105 | SEXP out = mkCharLenCE(newstr, outlen, getCharCE(x)); 106 | free(newstr); 107 | return out; 108 | } 109 | 110 | SEXP C_escape_chars(SEXP x) { 111 | if (!isString(x)) 112 | error("x must be a character vector."); 113 | if (x == R_NilValue || length(x) == 0) 114 | return x; 115 | 116 | int len = length(x); 117 | SEXP out = PROTECT(allocVector(STRSXP, len)); 118 | 119 | for (int i=0; i 2 | #include "modp_numtoa.h" 3 | #define NA_INTEGER64 LLONG_MIN 4 | 5 | SEXP R_integer64_to_char(SEXP x, SEXP na_as_string){ 6 | int len = length(x); 7 | int na_string = asLogical(na_as_string); 8 | long long * xint = (long long *) REAL(x); 9 | char buf[32]; 10 | SEXP out = PROTECT(allocVector(STRSXP, len)); 11 | for (int i = 0; i < len; i++) { 12 | if(xint[i] == NA_INTEGER64){ 13 | if(na_string == NA_LOGICAL){ 14 | SET_STRING_ELT(out, i, NA_STRING); 15 | } else if(na_string){ 16 | SET_STRING_ELT(out, i, mkChar("\"NA\"")); 17 | } else { 18 | SET_STRING_ELT(out, i, mkChar("null")); 19 | } 20 | } else { 21 | #ifdef _WIN32 22 | snprintf(buf, 32, "%lld", xint[i]); 23 | #else 24 | //snprintf(buf, 32, "%lld", xint[i]); 25 | //modp is faster (but does not work on windows) 26 | modp_litoa10(xint[i], buf); 27 | #endif 28 | SET_STRING_ELT(out, i, mkChar(buf)); 29 | } 30 | } 31 | UNPROTECT(1); 32 | return out; 33 | } 34 | -------------------------------------------------------------------------------- /src/is_datelist.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | 4 | //tests if all elements are either NULL or POSIXct, and at least one POSIXct 5 | SEXP C_is_datelist(SEXP x) { 6 | size_t len = Rf_length(x); 7 | if(!Rf_isVectorList(x) || len == 0) 8 | return ScalarLogical(FALSE); 9 | 10 | // Need 11 | int status = FALSE; 12 | for (size_t i = 0; i < len; i++) { 13 | SEXP el = VECTOR_ELT(x, i); 14 | if(Rf_isNull(el)) 15 | continue; 16 | if(Rf_isString(el) && Rf_length(el) > 0 && !strcmp(CHAR(STRING_ELT(el, 0)), "NA")) 17 | continue; 18 | if(Rf_isNumeric(el) && Rf_inherits(el, "POSIXct")){ 19 | status = TRUE; //at least one date 20 | } else { 21 | return ScalarLogical(FALSE); // quit immediately 22 | } 23 | } 24 | 25 | return ScalarLogical(status); 26 | } 27 | -------------------------------------------------------------------------------- /src/is_recordlist.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | 6 | // .Call("C_is_namedlist", PACKAGE = "jsonlite", 123) 7 | static bool is_namedlist(SEXP x) { 8 | if(TYPEOF(x) == VECSXP && getAttrib(x, R_NamesSymbol) != R_NilValue){ 9 | return true; 10 | } 11 | return false; 12 | } 13 | 14 | static bool is_unnamedlist(SEXP x) { 15 | if(TYPEOF(x) == VECSXP && getAttrib(x, R_NamesSymbol) == R_NilValue){ 16 | return true; 17 | } 18 | return false; 19 | } 20 | 21 | static bool is_namedlist_or_null(SEXP x){ 22 | return (is_namedlist(x) || (x == R_NilValue)); 23 | } 24 | 25 | static bool is_recordlist(SEXP x){ 26 | bool at_least_one_object = false; 27 | if(!is_unnamedlist(x)){ 28 | return false; 29 | } 30 | int len = length(x); 31 | if(len < 1){ 32 | return false; 33 | } 34 | for (int i=0; i 2 | #include 3 | #include 4 | #include 5 | 6 | SEXP C_is_scalarlist(SEXP x) { 7 | 8 | bool is_scalarlist = true; 9 | if (TYPEOF(x) != VECSXP){ 10 | is_scalarlist = false; 11 | } else { 12 | SEXP el; 13 | int len = length(x); 14 | for (int i=0; i 21 | * Copyright © 2007, Nick Galbreath -- nickg [at] client9 [dot] com 22 | * All rights reserved. 23 | * http://code.google.com/p/stringencoders/ 24 | * Released under the MIT license. 25 | * 26 | * 27 | */ 28 | 29 | #ifndef COM_MODP_STRINGENCODERS_NUMTOA_H 30 | #define COM_MODP_STRINGENCODERS_NUMTOA_H 31 | 32 | //#include "extern_c_begin.h" 33 | 34 | #include 35 | #include 36 | #include 37 | 38 | /** \brief convert an signed integer to char buffer 39 | * 40 | * \param[in] value 41 | * \param[out] buf the output buffer. Should be 16 chars or more. 42 | */ 43 | size_t modp_itoa10(int32_t value, char* buf); 44 | 45 | /** \brief convert an unsigned integer to char buffer 46 | * 47 | * \param[in] value 48 | * \param[out] buf The output buffer, should be 16 chars or more. 49 | */ 50 | size_t modp_uitoa10(uint32_t value, char* buf); 51 | 52 | /** \brief convert an signed long integer to char buffer 53 | * 54 | * \param[in] value 55 | * \param[out] buf the output buffer. Should be 24 chars or more. 56 | */ 57 | size_t modp_litoa10(int64_t value, char* buf); 58 | 59 | /** \brief convert an unsigned long integer to char buffer 60 | * 61 | * \param[in] value 62 | * \param[out] buf The output buffer, should be 24 chars or more. 63 | */ 64 | size_t modp_ulitoa10(uint64_t value, char* buf); 65 | 66 | /** \brief convert a floating point number to char buffer with 67 | * fixed-precision format 68 | * 69 | * This is similar to "%.[0-9]f" in the printf style. It will include 70 | * trailing zeros 71 | * 72 | * If the input value is greater than 1<<31, then the output format 73 | * will be switched exponential format. 74 | * 75 | * \param[in] value 76 | * \param[out] buf The allocated output buffer. Should be 32 chars or more. 77 | * \param[in] precision Number of digits to the right of the decimal point. 78 | * Can only be 0-9. 79 | */ 80 | size_t modp_dtoa(double value, char* buf, int precision); 81 | 82 | /** \brief convert a floating point number to char buffer with a 83 | * variable-precision format, and no trailing zeros 84 | * 85 | * This is similar to "%.[0-9]f" in the printf style, except it will 86 | * NOT include trailing zeros after the decimal point. This type 87 | * of format oddly does not exists with printf. 88 | * 89 | * If the input value is greater than 1<<31, then the output format 90 | * will be switched exponential format. 91 | * 92 | * \param[in] value 93 | * \param[out] buf The allocated output buffer. Should be 32 chars or more. 94 | * \param[in] precision Number of digits to the right of the decimal point. 95 | * Can only be 0-9. 96 | */ 97 | size_t modp_dtoa2(double value, char* buf, int precision); 98 | 99 | /** 100 | * adds a 8-character hexadecimal representation of value 101 | * 102 | */ 103 | char* modp_uitoa16(uint32_t value, char* buf, int final); 104 | 105 | //#include "extern_c_end.h" 106 | 107 | #endif 108 | -------------------------------------------------------------------------------- /src/null_to_na.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | 6 | /* 7 | This function takes a list and replaces all NULL values by NA. 8 | In addition, it will parse strings "NA" "NaN" "Inf" and "-Inf", 9 | unless there is at least one non-na string element in the list. 10 | In that case converting to real values has no point because 11 | unlist() will coerse them back into a string anyway. 12 | */ 13 | 14 | SEXP C_null_to_na(SEXP x) { 15 | int len = length(x); 16 | if(len == 0) return x; 17 | 18 | //null always turns into NA 19 | bool looks_like_character_vector = false; 20 | for (int i=0; i 2 | #include 3 | #include 4 | #include "modp_numtoa.h" 5 | 6 | SEXP R_num_to_char(SEXP x, SEXP digits, SEXP na_as_string, SEXP use_signif, SEXP always_decimal) { 7 | int len = length(x); 8 | int na_string = asLogical(na_as_string); 9 | int signif = asLogical(use_signif); 10 | int always_dec = asLogical(always_decimal); 11 | char buf[32]; 12 | SEXP out = PROTECT(allocVector(STRSXP, len)); 13 | if(isInteger(x)){ 14 | for (int i=0; i -1 && precision < 10 && fabs(val) < 2147483647 && fabs(val) > 1e-5) { 59 | //preferred method: fast with fixed decimal digits 60 | //does not support large numbers or scientific notation 61 | modp_dtoa2(val, buf, precision); 62 | } else { 63 | //fall back on sprintf (includes scientific notation) 64 | //funky formula is mostly to convert decimal digits into significant digits 65 | int decimals = ceil(fmin(17, fmax(1, log10(fabs(val))) + precision)); 66 | snprintf(buf, 32, "%.*g", decimals, val); 67 | } 68 | //if always_decimal = TRUE, then append .0 to whole numbers 69 | if(always_dec && strspn(buf, "0123456789-") == strlen(buf)){ 70 | strcat(buf, ".0"); 71 | } 72 | SET_STRING_ELT(out, i, mkChar(buf)); 73 | } 74 | } 75 | } else { 76 | error("num_to_char called with invalid object type."); 77 | } 78 | 79 | UNPROTECT(1); 80 | return out; 81 | } 82 | -------------------------------------------------------------------------------- /src/parse.c: -------------------------------------------------------------------------------- 1 | /* 2 | This function uses the YAJL tree parser to parse the entire document 3 | before converting it to an R list. It might be faster to use the YAJL 4 | callback mechanism instead to construct the R list immediately while 5 | parsing the JSON. But that looks very complicated. 6 | 7 | */ 8 | 9 | #include 10 | #include 11 | 12 | static SEXP ParseObject(yajl_val node, int bigint); 13 | static SEXP ParseArray(yajl_val node, int bigint); 14 | SEXP ParseValue(yajl_val node, int bigint); 15 | 16 | SEXP R_parse(SEXP x, SEXP bigint_as_char) { 17 | /* get data from R */ 18 | const char* json = translateCharUTF8(asChar(x)); 19 | const int bigint = asLogical(bigint_as_char); 20 | 21 | /* ignore BOM as suggested by RFC */ 22 | if(json[0] == '\xEF' && json[1] == '\xBB' && json[2] == '\xBF'){ 23 | warningcall(R_NilValue, "JSON string contains (illegal) UTF8 byte-order-mark!"); 24 | json = json + 3; 25 | } 26 | 27 | /* ignore rfc7464 record separator */ 28 | if(json[0] == '\x1E'){ 29 | json = json + 1; 30 | } 31 | 32 | /* parse json */ 33 | char errbuf[1024]; 34 | yajl_val node = yajl_tree_parse(json, errbuf, sizeof(errbuf)); 35 | 36 | /* parser error */ 37 | if (!node) { 38 | Rf_errorcall(R_NilValue, "%s", errbuf); 39 | } 40 | SEXP out = ParseValue(node, bigint); 41 | yajl_tree_free(node); 42 | return(out); 43 | } 44 | 45 | SEXP ParseValue(yajl_val node, int bigint){ 46 | if(YAJL_IS_NULL(node)){ 47 | return R_NilValue; 48 | } 49 | if(YAJL_IS_STRING(node)){ 50 | SEXP tmp = PROTECT(allocVector(STRSXP, 1)); 51 | SET_STRING_ELT(tmp, 0, mkCharCE(YAJL_GET_STRING(node), CE_UTF8)); 52 | UNPROTECT(1); 53 | return tmp; 54 | } 55 | if(YAJL_IS_INTEGER(node)){ 56 | long long int val = YAJL_GET_INTEGER(node); 57 | /* 2^53 is highest int stored as double without loss */ 58 | if(bigint && (val > 9007199254740992 || val < -9007199254740992)){ 59 | char buf[32]; 60 | snprintf(buf, 32, "%lld", val); 61 | return mkString(buf); 62 | /* see .Machine$integer.max in R */ 63 | } else if(val > 2147483647 || val < -2147483647){ 64 | return ScalarReal(val); 65 | } else { 66 | return ScalarInteger(val); 67 | } 68 | } 69 | if(YAJL_IS_DOUBLE(node)){ 70 | return(ScalarReal(YAJL_GET_DOUBLE(node))); 71 | } 72 | if(YAJL_IS_NUMBER(node)){ 73 | /* A number that is not int or double (very rare) */ 74 | /* This seems to correctly round to Inf/0/-Inf */ 75 | return(ScalarReal(YAJL_GET_DOUBLE(node))); 76 | } 77 | if(YAJL_IS_TRUE(node)){ 78 | return(ScalarLogical(1)); 79 | } 80 | if(YAJL_IS_FALSE(node)){ 81 | return(ScalarLogical(0)); 82 | } 83 | if(YAJL_IS_OBJECT(node)){ 84 | return(ParseObject(node, bigint)); 85 | } 86 | if(YAJL_IS_ARRAY(node)){ 87 | return(ParseArray(node, bigint)); 88 | } 89 | error("Invalid YAJL node type."); 90 | } 91 | 92 | static SEXP ParseObject(yajl_val node, int bigint){ 93 | int len = YAJL_GET_OBJECT(node)->len; 94 | SEXP keys = PROTECT(allocVector(STRSXP, len)); 95 | SEXP vec = PROTECT(allocVector(VECSXP, len)); 96 | for (int i = 0; i < len; ++i) { 97 | SET_STRING_ELT(keys, i, mkCharCE(YAJL_GET_OBJECT(node)->keys[i], CE_UTF8)); 98 | SET_VECTOR_ELT(vec, i, ParseValue(YAJL_GET_OBJECT(node)->values[i], bigint)); 99 | } 100 | setAttrib(vec, R_NamesSymbol, keys); 101 | UNPROTECT(2); 102 | return vec; 103 | } 104 | 105 | static SEXP ParseArray(yajl_val node, int bigint){ 106 | int len = YAJL_GET_ARRAY(node)->len; 107 | SEXP vec = PROTECT(allocVector(VECSXP, len)); 108 | for (int i = 0; i < len; ++i) { 109 | SET_VECTOR_ELT(vec, i, ParseValue(YAJL_GET_ARRAY(node)->values[i], bigint)); 110 | } 111 | UNPROTECT(1); 112 | return vec; 113 | } 114 | -------------------------------------------------------------------------------- /src/prettify.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | 6 | static int s_streamReformat = 0; 7 | 8 | #define GEN_AND_RETURN(func){\ 9 | yajl_gen_status __stat = func;\ 10 | if (__stat == yajl_gen_generation_complete && s_streamReformat) {\ 11 | yajl_gen_reset(g, "\n");\ 12 | __stat = func;\ 13 | }\ 14 | return __stat == yajl_gen_status_ok;\ 15 | } 16 | 17 | static int reformat_null(void * ctx) 18 | { 19 | yajl_gen g = (yajl_gen) ctx; 20 | GEN_AND_RETURN(yajl_gen_null(g)); 21 | } 22 | 23 | static int reformat_boolean(void * ctx, int boolean) 24 | { 25 | yajl_gen g = (yajl_gen) ctx; 26 | GEN_AND_RETURN(yajl_gen_bool(g, boolean)); 27 | } 28 | 29 | static int reformat_number(void * ctx, const char * s, size_t l) 30 | { 31 | yajl_gen g = (yajl_gen) ctx; 32 | GEN_AND_RETURN(yajl_gen_number(g, s, l)); 33 | } 34 | 35 | static int reformat_string(void * ctx, const unsigned char * stringVal, 36 | size_t stringLen) 37 | { 38 | yajl_gen g = (yajl_gen) ctx; 39 | GEN_AND_RETURN(yajl_gen_string(g, stringVal, stringLen)); 40 | } 41 | 42 | static int reformat_map_key(void * ctx, const unsigned char * stringVal, 43 | size_t stringLen) 44 | { 45 | yajl_gen g = (yajl_gen) ctx; 46 | GEN_AND_RETURN(yajl_gen_string(g, stringVal, stringLen)); 47 | } 48 | 49 | static int reformat_start_map(void * ctx) 50 | { 51 | yajl_gen g = (yajl_gen) ctx; 52 | GEN_AND_RETURN(yajl_gen_map_open(g)); 53 | } 54 | 55 | static int reformat_end_map(void * ctx) 56 | { 57 | yajl_gen g = (yajl_gen) ctx; 58 | GEN_AND_RETURN(yajl_gen_map_close(g)); 59 | } 60 | 61 | static int reformat_start_array(void * ctx) 62 | { 63 | yajl_gen g = (yajl_gen) ctx; 64 | GEN_AND_RETURN(yajl_gen_array_open(g)); 65 | } 66 | 67 | static int reformat_end_array(void * ctx) 68 | { 69 | yajl_gen g = (yajl_gen) ctx; 70 | GEN_AND_RETURN(yajl_gen_array_close(g)); 71 | } 72 | 73 | static yajl_callbacks callbacks = { 74 | reformat_null, 75 | reformat_boolean, 76 | NULL, 77 | NULL, 78 | reformat_number, 79 | reformat_string, 80 | reformat_start_map, 81 | reformat_map_key, 82 | reformat_end_map, 83 | reformat_start_array, 84 | reformat_end_array 85 | }; 86 | 87 | SEXP R_reformat(SEXP x, SEXP pretty, SEXP indent_string) { 88 | yajl_status stat; 89 | yajl_handle hand; 90 | yajl_gen g; 91 | SEXP output; 92 | 93 | /* init generator */ 94 | g = yajl_gen_alloc(NULL); 95 | yajl_gen_config(g, yajl_gen_beautify, asInteger(pretty)); 96 | yajl_gen_config(g, yajl_gen_indent_string, translateCharUTF8(asChar(indent_string))); 97 | yajl_gen_config(g, yajl_gen_validate_utf8, 0); 98 | yajl_gen_config(g, yajl_gen_escape_solidus, 1); //modified to only escape for " 2 | #include 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include "push_parser.h" 8 | 9 | #define bufsize 32768 10 | SEXP R_parse_connection(SEXP sConn, SEXP bigint_as_char){ 11 | int first = 1; 12 | char errbuf[bufsize]; 13 | unsigned char * errstr; 14 | yajl_handle push_parser = push_parser_new(); 15 | SEXP call = PROTECT(Rf_lang4( 16 | PROTECT(Rf_install("readBin")), 17 | sConn, 18 | PROTECT(Rf_allocVector(RAWSXP, 0)), 19 | PROTECT(Rf_ScalarInteger(bufsize)))); 20 | while(1){ 21 | SEXP out = PROTECT(Rf_eval(call, R_BaseEnv)); 22 | int len = Rf_length(out); 23 | if(len <= 0){ 24 | UNPROTECT(1); 25 | break; 26 | } 27 | unsigned char * ptr = RAW(out); 28 | 29 | //strip off BOM 30 | if(first && len > 3 && ptr[0] == 239 && ptr[1] == 187 && ptr[2] == 191){ 31 | warningcall(R_NilValue, "JSON string contains (illegal) UTF8 byte-order-mark!"); 32 | ptr += 3; 33 | len -= 3; 34 | } 35 | 36 | //strip off rfc7464 record separator 37 | if(first && len > 1 && ptr[0] == 30){ 38 | ptr += 1; 39 | len -= 1; 40 | } 41 | 42 | first = 0; 43 | 44 | /* parse and check for errors */ 45 | if (yajl_parse(push_parser, ptr, len) != yajl_status_ok){ 46 | errstr = yajl_get_error(push_parser, 1, ptr, len); 47 | goto JSON_FAIL; 48 | } 49 | UNPROTECT(1); 50 | } 51 | UNPROTECT(4); 52 | 53 | /* complete parse */ 54 | if (yajl_complete_parse(push_parser) != yajl_status_ok){ 55 | errstr = yajl_get_error(push_parser, 1, NULL, 0); 56 | goto JSON_FAIL; 57 | } 58 | 59 | /* get output */ 60 | yajl_val tree = push_parser_get(push_parser); 61 | SEXP out = PROTECT(ParseValue(tree, asLogical(bigint_as_char))); 62 | yajl_tree_free(tree); 63 | yajl_free(push_parser); 64 | UNPROTECT(1); 65 | return out; 66 | 67 | JSON_FAIL: 68 | strncpy(errbuf, (char *) errstr, bufsize - 1); 69 | yajl_free_error(push_parser, errstr); 70 | yajl_free(push_parser); 71 | Rf_error("%s", errbuf); 72 | } 73 | -------------------------------------------------------------------------------- /src/push_parser.h: -------------------------------------------------------------------------------- 1 | yajl_handle push_parser_new(void); 2 | yajl_val push_parser_get(yajl_handle handle); 3 | SEXP ParseValue(yajl_val node, int bigint_as_char); 4 | -------------------------------------------------------------------------------- /src/r-base64.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include "base64.h" 5 | 6 | SEXP R_base64_encode(SEXP buf){ 7 | if(TYPEOF(buf) != RAWSXP) 8 | Rf_error("base64 buf must be raw"); 9 | size_t len = Rf_length(buf); 10 | size_t outlen = 0; 11 | unsigned char * out = base64_encode(RAW(buf), len, &outlen); 12 | if(out == NULL) 13 | Rf_error("Error in base64 encode"); 14 | SEXP res = PROTECT(allocVector(STRSXP, 1)); 15 | SET_STRING_ELT(res, 0, mkCharLen((char*) out, outlen)); 16 | free(out); 17 | UNPROTECT(1); 18 | return res; 19 | } 20 | 21 | SEXP R_base64_decode(SEXP buf){ 22 | if(TYPEOF(buf) != RAWSXP) 23 | Rf_error("base64 buf must be raw"); 24 | size_t len = Rf_length(buf); 25 | size_t outlen = 0; 26 | unsigned char * out = base64_decode(RAW(buf), len, &outlen); 27 | if(out == NULL) 28 | Rf_error("Error in base64 decode"); 29 | SEXP res = allocVector(RAWSXP, outlen); 30 | memcpy(RAW(res), out, outlen); 31 | free(out); 32 | return res; 33 | } 34 | -------------------------------------------------------------------------------- /src/register.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include // for NULL 4 | #include 5 | #include 6 | 7 | /* .Call calls */ 8 | extern SEXP C_collapse_array(SEXP); 9 | extern SEXP C_collapse_array_pretty_inner(SEXP); 10 | extern SEXP C_collapse_array_pretty_outer(SEXP, SEXP); 11 | extern SEXP C_collapse_object(SEXP, SEXP); 12 | extern SEXP C_collapse_object_pretty(SEXP, SEXP, SEXP); 13 | extern SEXP C_escape_chars(SEXP); 14 | extern SEXP C_is_datelist(SEXP); 15 | extern SEXP C_is_recordlist(SEXP); 16 | extern SEXP C_is_scalarlist(SEXP); 17 | extern SEXP C_null_to_na(SEXP); 18 | extern SEXP C_row_collapse_array(SEXP, SEXP); 19 | extern SEXP C_row_collapse_object(SEXP, SEXP, SEXP); 20 | extern SEXP C_transpose_list(SEXP, SEXP); 21 | extern SEXP R_base64_decode(SEXP); 22 | extern SEXP R_base64_encode(SEXP); 23 | extern SEXP R_integer64_to_char(SEXP, SEXP); 24 | extern SEXP R_num_to_char(SEXP, SEXP, SEXP, SEXP, SEXP); 25 | extern SEXP R_parse(SEXP, SEXP); 26 | extern SEXP R_parse_connection(SEXP, SEXP); 27 | extern SEXP R_reformat(SEXP, SEXP, SEXP); 28 | extern SEXP R_validate(SEXP); 29 | 30 | static const R_CallMethodDef CallEntries[] = { 31 | {"C_collapse_array", (DL_FUNC) &C_collapse_array, 1}, 32 | {"C_collapse_array_pretty_inner", (DL_FUNC) &C_collapse_array_pretty_inner, 1}, 33 | {"C_collapse_array_pretty_outer", (DL_FUNC) &C_collapse_array_pretty_outer, 2}, 34 | {"C_collapse_object", (DL_FUNC) &C_collapse_object, 2}, 35 | {"C_collapse_object_pretty", (DL_FUNC) &C_collapse_object_pretty, 3}, 36 | {"C_escape_chars", (DL_FUNC) &C_escape_chars, 1}, 37 | {"C_is_datelist", (DL_FUNC) &C_is_datelist, 1}, 38 | {"C_is_recordlist", (DL_FUNC) &C_is_recordlist, 1}, 39 | {"C_is_scalarlist", (DL_FUNC) &C_is_scalarlist, 1}, 40 | {"C_null_to_na", (DL_FUNC) &C_null_to_na, 1}, 41 | {"C_row_collapse_array", (DL_FUNC) &C_row_collapse_array, 2}, 42 | {"C_row_collapse_object", (DL_FUNC) &C_row_collapse_object, 3}, 43 | {"C_transpose_list", (DL_FUNC) &C_transpose_list, 2}, 44 | {"R_base64_decode", (DL_FUNC) &R_base64_decode, 1}, 45 | {"R_base64_encode", (DL_FUNC) &R_base64_encode, 1}, 46 | {"R_integer64_to_char", (DL_FUNC) &R_integer64_to_char, 2}, 47 | {"R_num_to_char", (DL_FUNC) &R_num_to_char, 5}, 48 | {"R_parse", (DL_FUNC) &R_parse, 2}, 49 | {"R_parse_connection", (DL_FUNC) &R_parse_connection, 2}, 50 | {"R_reformat", (DL_FUNC) &R_reformat, 3}, 51 | {"R_validate", (DL_FUNC) &R_validate, 1}, 52 | {NULL, NULL, 0} 53 | }; 54 | 55 | attribute_visible void R_init_jsonlite(DllInfo *dll) 56 | { 57 | R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); 58 | R_useDynamicSymbols(dll, FALSE); 59 | } 60 | -------------------------------------------------------------------------------- /src/row_collapse.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | 5 | SEXP C_collapse_object(SEXP x, SEXP y); 6 | SEXP C_collapse_array(SEXP x); 7 | SEXP C_collapse_array_pretty_inner(SEXP x); 8 | SEXP C_collapse_object_pretty(SEXP x, SEXP y, SEXP indent); 9 | 10 | SEXP C_row_collapse_object(SEXP names, SEXP m, SEXP indent){ 11 | //get matrix dimensions 12 | int *dims = INTEGER(getAttrib(m, R_DimSymbol)); 13 | int x = dims[0]; 14 | int y = dims[1]; 15 | 16 | //allocate the output vector 17 | SEXP out = PROTECT(allocVector(STRSXP, x)); 18 | SEXP vec = PROTECT(allocVector(STRSXP, y)); 19 | for(int i = 0; i < x; i++) { 20 | for(int j = 0; j < y; j++) { 21 | SET_STRING_ELT(vec, j, STRING_ELT(m, j*x + i)); 22 | } 23 | if(asInteger(indent) == NA_INTEGER){ 24 | SET_STRING_ELT(out, i, STRING_ELT(C_collapse_object(names, vec), 0)); 25 | } else { 26 | SET_STRING_ELT(out, i, STRING_ELT(C_collapse_object_pretty(names, vec, indent), 0)); 27 | } 28 | } 29 | UNPROTECT(2); 30 | return out; 31 | } 32 | 33 | 34 | SEXP C_row_collapse_array(SEXP m, SEXP indent){ 35 | //get matrix dimensions 36 | int *dims = INTEGER(getAttrib(m, R_DimSymbol)); 37 | int x = dims[0]; 38 | int y = dims[1]; 39 | 40 | //allocate the output vector 41 | SEXP out = PROTECT(allocVector(STRSXP, x)); 42 | SEXP vec = PROTECT(allocVector(STRSXP, y)); 43 | for(int i = 0; i < x; i++) { 44 | for(int j = 0; j < y; j++) { 45 | SET_STRING_ELT(vec, j, STRING_ELT(m, j*x + i)); 46 | } 47 | if(asInteger(indent) == NA_INTEGER){ 48 | SET_STRING_ELT(out, i, STRING_ELT(C_collapse_array(vec), 0)); 49 | } else { 50 | SET_STRING_ELT(out, i, STRING_ELT(C_collapse_array_pretty_inner(vec), 0)); 51 | } 52 | } 53 | UNPROTECT(2); 54 | return out; 55 | } 56 | -------------------------------------------------------------------------------- /src/transpose_list.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | 4 | SEXP C_transpose_list(SEXP x, SEXP names) { 5 | size_t ncol = Rf_length(names); 6 | size_t nrow = Rf_length(x); 7 | SEXP out = PROTECT(allocVector(VECSXP, ncol)); 8 | for(size_t i = 0; i < ncol; i++){ 9 | const char * targetname = CHAR(STRING_ELT(names, i)); 10 | SEXP col = PROTECT(allocVector(VECSXP, nrow)); 11 | for(size_t j = 0; j < nrow; j++){ 12 | //search for 'targetname' in each record j 13 | SEXP list = VECTOR_ELT(x, j); 14 | SEXP listnames = getAttrib(list, R_NamesSymbol); 15 | for(size_t k = 0; k < Rf_length(listnames); k++){ 16 | if(!strcmp(CHAR(STRING_ELT(listnames, k)), targetname)){ 17 | SET_VECTOR_ELT(col, j, VECTOR_ELT(list, k)); 18 | break; 19 | } 20 | } 21 | } 22 | SET_VECTOR_ELT(out, i, col); 23 | UNPROTECT(1); 24 | } 25 | //setAttrib(out, R_NamesSymbol, names); 26 | UNPROTECT(1); 27 | return out; 28 | } 29 | -------------------------------------------------------------------------------- /src/validate.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | 5 | SEXP R_validate(SEXP x) { 6 | /* get data from R */ 7 | const char* json = translateCharUTF8(asChar(x)); 8 | 9 | /* test for BOM */ 10 | if(json[0] == '\xEF' && json[1] == '\xBB' && json[2] == '\xBF'){ 11 | SEXP output = PROTECT(duplicate(ScalarLogical(0))); 12 | SEXP msg = PROTECT(Rf_mkString("JSON string contains UTF8 byte-order-mark.")); 13 | setAttrib(output, install("err"), msg); 14 | UNPROTECT(2); 15 | return(output); 16 | } 17 | 18 | /* allocate a parser */ 19 | yajl_handle hand = yajl_alloc(NULL, NULL, NULL); 20 | 21 | /* parser options */ 22 | //yajl_config(hand, yajl_dont_validate_strings, 1); 23 | 24 | /* go parse */ 25 | const size_t rd = strlen(json); 26 | yajl_status stat = yajl_parse(hand, (const unsigned char*) json, rd); 27 | if(stat == yajl_status_ok) { 28 | stat = yajl_complete_parse(hand); 29 | } 30 | 31 | SEXP output = PROTECT(duplicate(ScalarLogical(!stat))); 32 | 33 | //error message 34 | if (stat != yajl_status_ok) { 35 | unsigned char* str = yajl_get_error(hand, 1, (const unsigned char*) json, rd); 36 | SEXP errstr = PROTECT(mkString((const char *) str)); 37 | SEXP offset = PROTECT(ScalarInteger(yajl_get_bytes_consumed(hand))); 38 | yajl_free_error(hand, str); 39 | setAttrib(output, install("offset"), offset); 40 | setAttrib(output, install("err"), errstr); 41 | UNPROTECT(2); 42 | } 43 | 44 | /* return boolean vec (0 means no errors, means is valid) */ 45 | yajl_free(hand); 46 | UNPROTECT(1); 47 | return output; 48 | } 49 | -------------------------------------------------------------------------------- /src/yajl/api/yajl_common.h: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2007-2014, Lloyd Hilaiel 3 | * 4 | * Permission to use, copy, modify, and/or distribute this software for any 5 | * purpose with or without fee is hereby granted, provided that the above 6 | * copyright notice and this permission notice appear in all copies. 7 | * 8 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | */ 16 | 17 | #ifndef __YAJL_COMMON_H__ 18 | #define __YAJL_COMMON_H__ 19 | 20 | #include 21 | 22 | #ifdef __cplusplus 23 | extern "C" { 24 | #endif 25 | 26 | #define YAJL_MAX_DEPTH 128 27 | 28 | /* msft dll export gunk. To build a DLL on windows, you 29 | * must define WIN32, YAJL_SHARED, and YAJL_BUILD. To use a shared 30 | * DLL, you must define YAJL_SHARED and WIN32 */ 31 | #if (defined(_WIN32) || defined(WIN32)) && defined(YAJL_SHARED) 32 | # ifdef YAJL_BUILD 33 | # define YAJL_API __declspec(dllexport) 34 | # else 35 | # define YAJL_API __declspec(dllimport) 36 | # endif 37 | #else 38 | # if defined(__GNUC__) && (__GNUC__ * 100 + __GNUC_MINOR__) >= 303 39 | # define YAJL_API 40 | # else 41 | # define YAJL_API 42 | # endif 43 | #endif 44 | 45 | /** pointer to a malloc function, supporting client overriding memory 46 | * allocation routines */ 47 | typedef void * (*yajl_malloc_func)(void *ctx, size_t sz); 48 | 49 | /** pointer to a free function, supporting client overriding memory 50 | * allocation routines */ 51 | typedef void (*yajl_free_func)(void *ctx, void * ptr); 52 | 53 | /** pointer to a realloc function which can resize an allocation. */ 54 | typedef void * (*yajl_realloc_func)(void *ctx, void * ptr, size_t sz); 55 | 56 | /** A structure which can be passed to yajl_*_alloc routines to allow the 57 | * client to specify memory allocation functions to be used. */ 58 | typedef struct 59 | { 60 | /** pointer to a function that can allocate uninitialized memory */ 61 | yajl_malloc_func malloc; 62 | /** pointer to a function that can resize memory allocations */ 63 | yajl_realloc_func realloc; 64 | /** pointer to a function that can free memory allocated using 65 | * reallocFunction or mallocFunction */ 66 | yajl_free_func free; 67 | /** a context pointer that will be passed to above allocation routines */ 68 | void * ctx; 69 | } yajl_alloc_funcs; 70 | 71 | #ifdef __cplusplus 72 | } 73 | #endif 74 | 75 | #endif 76 | -------------------------------------------------------------------------------- /src/yajl/api/yajl_version.h: -------------------------------------------------------------------------------- 1 | #ifndef YAJL_VERSION_H_ 2 | #define YAJL_VERSION_H_ 3 | 4 | #include 5 | 6 | #define YAJL_MAJOR 2 7 | #define YAJL_MINOR 1 8 | #define YAJL_MICRO 1 9 | 10 | #define YAJL_VERSION ((YAJL_MAJOR * 10000) + (YAJL_MINOR * 100) + YAJL_MICRO) 11 | 12 | #ifdef __cplusplus 13 | extern "C" { 14 | #endif 15 | 16 | extern int YAJL_API yajl_version(void); 17 | 18 | #ifdef __cplusplus 19 | } 20 | #endif 21 | 22 | #endif /* YAJL_VERSION_H_ */ 23 | 24 | -------------------------------------------------------------------------------- /src/yajl/readme.txt: -------------------------------------------------------------------------------- 1 | Changes in yajl code by Jeroen: 2 | 3 | - Manually changed the header include paths in some c/h files to avoid cmake dependency. 4 | - Comment out call to abort() in src/yajl/yajl_parser.c (for CMD check) 5 | - Manually generated yajl.version.h from yajl.version.h.in (by running cmake) 6 | - Patch for CMD check warnings on Windows: https://github.com/lloyd/yajl/issues/143 7 | - Patch for error messages in yajl_tree_parse: https://github.com/lloyd/yajl/issues/144 8 | - Fix for windows XP: https://rt.cpan.org/Public/Bug/Display.html?id=69113 9 | - in yajl_tree.c added functions: push_parser_new and push_parser_get 10 | -------------------------------------------------------------------------------- /src/yajl/yajl_alloc.c: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2007-2014, Lloyd Hilaiel 3 | * 4 | * Permission to use, copy, modify, and/or distribute this software for any 5 | * purpose with or without fee is hereby granted, provided that the above 6 | * copyright notice and this permission notice appear in all copies. 7 | * 8 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | */ 16 | 17 | /** 18 | * \file yajl_alloc.h 19 | * default memory allocation routines for yajl which use malloc/realloc and 20 | * free 21 | */ 22 | 23 | #include "yajl_alloc.h" 24 | #include 25 | 26 | static void * yajl_internal_malloc(void *ctx, size_t sz) 27 | { 28 | (void)ctx; 29 | return malloc(sz); 30 | } 31 | 32 | static void * yajl_internal_realloc(void *ctx, void * previous, 33 | size_t sz) 34 | { 35 | (void)ctx; 36 | return realloc(previous, sz); 37 | } 38 | 39 | static void yajl_internal_free(void *ctx, void * ptr) 40 | { 41 | (void)ctx; 42 | free(ptr); 43 | } 44 | 45 | void yajl_set_default_alloc_funcs(yajl_alloc_funcs * yaf) 46 | { 47 | yaf->malloc = yajl_internal_malloc; 48 | yaf->free = yajl_internal_free; 49 | yaf->realloc = yajl_internal_realloc; 50 | yaf->ctx = NULL; 51 | } 52 | 53 | -------------------------------------------------------------------------------- /src/yajl/yajl_alloc.h: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2007-2014, Lloyd Hilaiel 3 | * 4 | * Permission to use, copy, modify, and/or distribute this software for any 5 | * purpose with or without fee is hereby granted, provided that the above 6 | * copyright notice and this permission notice appear in all copies. 7 | * 8 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | */ 16 | 17 | /** 18 | * \file yajl_alloc.h 19 | * default memory allocation routines for yajl which use malloc/realloc and 20 | * free 21 | */ 22 | 23 | #ifndef __YAJL_ALLOC_H__ 24 | #define __YAJL_ALLOC_H__ 25 | 26 | #include "api/yajl_common.h" 27 | 28 | #define YA_MALLOC(afs, sz) (afs)->malloc((afs)->ctx, (sz)) 29 | #define YA_FREE(afs, ptr) (afs)->free((afs)->ctx, (ptr)) 30 | #define YA_REALLOC(afs, ptr, sz) (afs)->realloc((afs)->ctx, (ptr), (sz)) 31 | 32 | void yajl_set_default_alloc_funcs(yajl_alloc_funcs * yaf); 33 | 34 | #endif 35 | -------------------------------------------------------------------------------- /src/yajl/yajl_buf.c: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2007-2014, Lloyd Hilaiel 3 | * 4 | * Permission to use, copy, modify, and/or distribute this software for any 5 | * purpose with or without fee is hereby granted, provided that the above 6 | * copyright notice and this permission notice appear in all copies. 7 | * 8 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | */ 16 | 17 | #include "yajl_buf.h" 18 | 19 | #include 20 | #include 21 | #include 22 | 23 | #define YAJL_BUF_INIT_SIZE 2048 24 | 25 | struct yajl_buf_t { 26 | size_t len; 27 | size_t used; 28 | unsigned char * data; 29 | yajl_alloc_funcs * alloc; 30 | }; 31 | 32 | static 33 | void yajl_buf_ensure_available(yajl_buf buf, size_t want) 34 | { 35 | size_t need; 36 | 37 | assert(buf != NULL); 38 | 39 | /* first call */ 40 | if (buf->data == NULL) { 41 | buf->len = YAJL_BUF_INIT_SIZE; 42 | buf->data = (unsigned char *) YA_MALLOC(buf->alloc, buf->len); 43 | buf->data[0] = 0; 44 | } 45 | 46 | need = buf->len; 47 | 48 | if (((buf->used > want) ? buf->used : want) > (size_t)(buf->used + want)) { 49 | /* We cannot allocate more memory than SIZE_MAX. */ 50 | abort(); 51 | } 52 | while (want >= (need - buf->used)) { 53 | if (need >= (size_t)((size_t)(-1)<<1)>>1) { 54 | /* need would overflow. */ 55 | abort(); 56 | } 57 | need <<= 1; 58 | } 59 | 60 | if (need != buf->len) { 61 | buf->data = (unsigned char *) YA_REALLOC(buf->alloc, buf->data, need); 62 | buf->len = need; 63 | } 64 | } 65 | 66 | yajl_buf yajl_buf_alloc(yajl_alloc_funcs * alloc) 67 | { 68 | yajl_buf b = YA_MALLOC(alloc, sizeof(struct yajl_buf_t)); 69 | memset((void *) b, 0, sizeof(struct yajl_buf_t)); 70 | b->alloc = alloc; 71 | return b; 72 | } 73 | 74 | void yajl_buf_free(yajl_buf buf) 75 | { 76 | assert(buf != NULL); 77 | if (buf->data) YA_FREE(buf->alloc, buf->data); 78 | YA_FREE(buf->alloc, buf); 79 | } 80 | 81 | void yajl_buf_append(yajl_buf buf, const void * data, size_t len) 82 | { 83 | yajl_buf_ensure_available(buf, len); 84 | if (len > 0) { 85 | assert(data != NULL); 86 | memcpy(buf->data + buf->used, data, len); 87 | buf->used += len; 88 | buf->data[buf->used] = 0; 89 | } 90 | } 91 | 92 | void yajl_buf_clear(yajl_buf buf) 93 | { 94 | buf->used = 0; 95 | if (buf->data) buf->data[buf->used] = 0; 96 | } 97 | 98 | const unsigned char * yajl_buf_data(yajl_buf buf) 99 | { 100 | return buf->data; 101 | } 102 | 103 | size_t yajl_buf_len(yajl_buf buf) 104 | { 105 | return buf->used; 106 | } 107 | 108 | void 109 | yajl_buf_truncate(yajl_buf buf, size_t len) 110 | { 111 | assert(len <= buf->used); 112 | buf->used = len; 113 | } 114 | -------------------------------------------------------------------------------- /src/yajl/yajl_buf.h: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2007-2014, Lloyd Hilaiel 3 | * 4 | * Permission to use, copy, modify, and/or distribute this software for any 5 | * purpose with or without fee is hereby granted, provided that the above 6 | * copyright notice and this permission notice appear in all copies. 7 | * 8 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | */ 16 | 17 | #ifndef __YAJL_BUF_H__ 18 | #define __YAJL_BUF_H__ 19 | 20 | #include "api/yajl_common.h" 21 | #include "yajl_alloc.h" 22 | 23 | /* 24 | * Implementation/performance notes. If this were moved to a header 25 | * only implementation using #define's where possible we might be 26 | * able to sqeeze a little performance out of the guy by killing function 27 | * call overhead. YMMV. 28 | */ 29 | 30 | /** 31 | * yajl_buf is a buffer with exponential growth. the buffer ensures that 32 | * you are always null padded. 33 | */ 34 | typedef struct yajl_buf_t * yajl_buf; 35 | 36 | /* allocate a new buffer */ 37 | yajl_buf yajl_buf_alloc(yajl_alloc_funcs * alloc); 38 | 39 | /* free the buffer */ 40 | void yajl_buf_free(yajl_buf buf); 41 | 42 | /* append a number of bytes to the buffer */ 43 | void yajl_buf_append(yajl_buf buf, const void * data, size_t len); 44 | 45 | /* empty the buffer */ 46 | void yajl_buf_clear(yajl_buf buf); 47 | 48 | /* get a pointer to the beginning of the buffer */ 49 | const unsigned char * yajl_buf_data(yajl_buf buf); 50 | 51 | /* get the length of the buffer */ 52 | size_t yajl_buf_len(yajl_buf buf); 53 | 54 | /* truncate the buffer */ 55 | void yajl_buf_truncate(yajl_buf buf, size_t len); 56 | 57 | #endif 58 | -------------------------------------------------------------------------------- /src/yajl/yajl_bytestack.h: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2007-2014, Lloyd Hilaiel 3 | * 4 | * Permission to use, copy, modify, and/or distribute this software for any 5 | * purpose with or without fee is hereby granted, provided that the above 6 | * copyright notice and this permission notice appear in all copies. 7 | * 8 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | */ 16 | 17 | /* 18 | * A header only implementation of a simple stack of bytes, used in YAJL 19 | * to maintain parse state. 20 | */ 21 | 22 | #ifndef __YAJL_BYTESTACK_H__ 23 | #define __YAJL_BYTESTACK_H__ 24 | 25 | #include "api/yajl_common.h" 26 | 27 | #define YAJL_BS_INC 128 28 | 29 | typedef struct yajl_bytestack_t 30 | { 31 | unsigned char * stack; 32 | size_t size; 33 | size_t used; 34 | yajl_alloc_funcs * yaf; 35 | } yajl_bytestack; 36 | 37 | /* initialize a bytestack */ 38 | #define yajl_bs_init(obs, _yaf) { \ 39 | (obs).stack = NULL; \ 40 | (obs).size = 0; \ 41 | (obs).used = 0; \ 42 | (obs).yaf = (_yaf); \ 43 | } \ 44 | 45 | 46 | /* initialize a bytestack */ 47 | #define yajl_bs_free(obs) \ 48 | if ((obs).stack) (obs).yaf->free((obs).yaf->ctx, (obs).stack); 49 | 50 | #define yajl_bs_current(obs) \ 51 | (assert((obs).used > 0), (obs).stack[(obs).used - 1]) 52 | 53 | #define yajl_bs_push(obs, byte) { \ 54 | if (((obs).size - (obs).used) == 0) { \ 55 | (obs).size += YAJL_BS_INC; \ 56 | (obs).stack = (obs).yaf->realloc((obs).yaf->ctx,\ 57 | (void *) (obs).stack, (obs).size);\ 58 | } \ 59 | (obs).stack[((obs).used)++] = (byte); \ 60 | } 61 | 62 | /* removes the top item of the stack, returns nothing */ 63 | #define yajl_bs_pop(obs) { ((obs).used)--; } 64 | 65 | #define yajl_bs_set(obs, byte) \ 66 | (obs).stack[((obs).used) - 1] = (byte); 67 | 68 | 69 | #endif 70 | -------------------------------------------------------------------------------- /src/yajl/yajl_encode.h: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2007-2014, Lloyd Hilaiel 3 | * 4 | * Permission to use, copy, modify, and/or distribute this software for any 5 | * purpose with or without fee is hereby granted, provided that the above 6 | * copyright notice and this permission notice appear in all copies. 7 | * 8 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | */ 16 | 17 | #ifndef __YAJL_ENCODE_H__ 18 | #define __YAJL_ENCODE_H__ 19 | 20 | #include "yajl_buf.h" 21 | #include "api/yajl_gen.h" 22 | 23 | void yajl_string_encode(const yajl_print_t printer, 24 | void * ctx, 25 | const unsigned char * str, 26 | size_t length, 27 | int escape_solidus); 28 | 29 | void yajl_string_decode(yajl_buf buf, const unsigned char * str, 30 | size_t length); 31 | 32 | int yajl_string_validate_utf8(const unsigned char * s, size_t len); 33 | 34 | #endif 35 | -------------------------------------------------------------------------------- /src/yajl/yajl_lex.h: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2007-2014, Lloyd Hilaiel 3 | * 4 | * Permission to use, copy, modify, and/or distribute this software for any 5 | * purpose with or without fee is hereby granted, provided that the above 6 | * copyright notice and this permission notice appear in all copies. 7 | * 8 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | */ 16 | 17 | #ifndef __YAJL_LEX_H__ 18 | #define __YAJL_LEX_H__ 19 | 20 | #include "api/yajl_common.h" 21 | 22 | typedef enum { 23 | yajl_tok_bool, 24 | yajl_tok_colon, 25 | yajl_tok_comma, 26 | yajl_tok_eof, 27 | yajl_tok_error, 28 | yajl_tok_left_brace, 29 | yajl_tok_left_bracket, 30 | yajl_tok_null, 31 | yajl_tok_right_brace, 32 | yajl_tok_right_bracket, 33 | 34 | /* we differentiate between integers and doubles to allow the 35 | * parser to interpret the number without re-scanning */ 36 | yajl_tok_integer, 37 | yajl_tok_double, 38 | 39 | /* we differentiate between strings which require further processing, 40 | * and strings that do not */ 41 | yajl_tok_string, 42 | yajl_tok_string_with_escapes, 43 | 44 | /* comment tokens are not currently returned to the parser, ever */ 45 | yajl_tok_comment 46 | } yajl_tok; 47 | 48 | typedef struct yajl_lexer_t * yajl_lexer; 49 | 50 | yajl_lexer yajl_lex_alloc(yajl_alloc_funcs * alloc, 51 | unsigned int allowComments, 52 | unsigned int validateUTF8); 53 | 54 | void yajl_lex_free(yajl_lexer lexer); 55 | 56 | /** 57 | * run/continue a lex. "offset" is an input/output parameter. 58 | * It should be initialized to zero for a 59 | * new chunk of target text, and upon subsetquent calls with the same 60 | * target text should passed with the value of the previous invocation. 61 | * 62 | * the client may be interested in the value of offset when an error is 63 | * returned from the lexer. This allows the client to render useful 64 | * error messages. 65 | * 66 | * When you pass the next chunk of data, context should be reinitialized 67 | * to zero. 68 | * 69 | * Finally, the output buffer is usually just a pointer into the jsonText, 70 | * however in cases where the entity being lexed spans multiple chunks, 71 | * the lexer will buffer the entity and the data returned will be 72 | * a pointer into that buffer. 73 | * 74 | * This behavior is abstracted from client code except for the performance 75 | * implications which require that the client choose a reasonable chunk 76 | * size to get adequate performance. 77 | */ 78 | yajl_tok yajl_lex_lex(yajl_lexer lexer, const unsigned char * jsonText, 79 | size_t jsonTextLen, size_t * offset, 80 | const unsigned char ** outBuf, size_t * outLen); 81 | 82 | /** have a peek at the next token, but don't move the lexer forward */ 83 | yajl_tok yajl_lex_peek(yajl_lexer lexer, const unsigned char * jsonText, 84 | size_t jsonTextLen, size_t offset); 85 | 86 | 87 | typedef enum { 88 | yajl_lex_e_ok = 0, 89 | yajl_lex_string_invalid_utf8, 90 | yajl_lex_string_invalid_escaped_char, 91 | yajl_lex_string_invalid_json_char, 92 | yajl_lex_string_invalid_hex_char, 93 | yajl_lex_invalid_char, 94 | yajl_lex_invalid_string, 95 | yajl_lex_missing_integer_after_decimal, 96 | yajl_lex_missing_integer_after_exponent, 97 | yajl_lex_missing_integer_after_minus, 98 | yajl_lex_unallowed_comment 99 | } yajl_lex_error; 100 | 101 | const char * yajl_lex_error_to_string(yajl_lex_error error); 102 | 103 | /** allows access to more specific information about the lexical 104 | * error when yajl_lex_lex returns yajl_tok_error. */ 105 | yajl_lex_error yajl_lex_get_error(yajl_lexer lexer); 106 | 107 | /** get the current offset into the most recently lexed json string. */ 108 | size_t yajl_lex_current_offset(yajl_lexer lexer); 109 | 110 | /** get the number of lines lexed by this lexer instance */ 111 | size_t yajl_lex_current_line(yajl_lexer lexer); 112 | 113 | /** get the number of chars lexed by this lexer instance since the last 114 | * \n or \r */ 115 | size_t yajl_lex_current_char(yajl_lexer lexer); 116 | 117 | #endif 118 | -------------------------------------------------------------------------------- /src/yajl/yajl_parser.h: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2007-2014, Lloyd Hilaiel 3 | * 4 | * Permission to use, copy, modify, and/or distribute this software for any 5 | * purpose with or without fee is hereby granted, provided that the above 6 | * copyright notice and this permission notice appear in all copies. 7 | * 8 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | */ 16 | 17 | #ifndef __YAJL_PARSER_H__ 18 | #define __YAJL_PARSER_H__ 19 | 20 | #include "api/yajl_parse.h" 21 | #include "yajl_bytestack.h" 22 | #include "yajl_buf.h" 23 | #include "yajl_lex.h" 24 | 25 | 26 | typedef enum { 27 | yajl_state_start = 0, 28 | yajl_state_parse_complete, 29 | yajl_state_parse_error, 30 | yajl_state_lexical_error, 31 | yajl_state_map_start, 32 | yajl_state_map_sep, 33 | yajl_state_map_need_val, 34 | yajl_state_map_got_val, 35 | yajl_state_map_need_key, 36 | yajl_state_array_start, 37 | yajl_state_array_got_val, 38 | yajl_state_array_need_val, 39 | yajl_state_got_value, 40 | } yajl_state; 41 | 42 | struct yajl_handle_t { 43 | const yajl_callbacks * callbacks; 44 | void * ctx; 45 | yajl_lexer lexer; 46 | const char * parseError; 47 | /* the number of bytes consumed from the last client buffer, 48 | * in the case of an error this will be an error offset, in the 49 | * case of an error this can be used as the error offset */ 50 | size_t bytesConsumed; 51 | /* temporary storage for decoded strings */ 52 | yajl_buf decodeBuf; 53 | /* a stack of states. access with yajl_state_XXX routines */ 54 | yajl_bytestack stateStack; 55 | /* memory allocation routines */ 56 | yajl_alloc_funcs alloc; 57 | /* bitfield */ 58 | unsigned int flags; 59 | }; 60 | 61 | yajl_status 62 | yajl_do_parse(yajl_handle handle, const unsigned char * jsonText, 63 | size_t jsonTextLen); 64 | 65 | yajl_status 66 | yajl_do_finish(yajl_handle handle); 67 | 68 | unsigned char * 69 | yajl_render_error_string(yajl_handle hand, const unsigned char * jsonText, 70 | size_t jsonTextLen, int verbose); 71 | 72 | /* A little built in integer parsing routine with the same semantics as strtol 73 | * that's unaffected by LOCALE. */ 74 | long long 75 | yajl_parse_integer(const unsigned char *number, unsigned int length); 76 | 77 | 78 | #endif 79 | -------------------------------------------------------------------------------- /src/yajl/yajl_version.c: -------------------------------------------------------------------------------- 1 | #include "api/yajl_version.h" 2 | 3 | int yajl_version(void) 4 | { 5 | return YAJL_VERSION; 6 | } 7 | 8 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(jsonlite) 3 | 4 | test_check("jsonlite", filter = "toJSON|fromJSON|libjson|serializeJSON") 5 | -------------------------------------------------------------------------------- /tests/testthat/flatten.R: -------------------------------------------------------------------------------- 1 | test_that("flattening", { 2 | x <- list(test = data.frame(foo = 1:3)) 3 | x$test$bar <- data.frame(x = 5:3, y = 7:9) 4 | expect_equal(x, fromJSON(toJSON(x), flatten = FALSE)) 5 | expect_equal(names(fromJSON(toJSON(x), flatten = TRUE)$test), c("foo", "bar.x", "bar.y")) 6 | }) 7 | -------------------------------------------------------------------------------- /tests/testthat/helper-toJSON.R: -------------------------------------------------------------------------------- 1 | toJSON <- function(...) { 2 | unclass(jsonlite::toJSON(...)) 3 | } 4 | 5 | toJSON2 <- function(x) { 6 | toJSON(x, keep_vec_names = TRUE, auto_unbox = TRUE) 7 | } 8 | 9 | toJSON3 <- function(x) { 10 | toJSON(x, keep_vec_names = TRUE, auto_unbox = TRUE, dataframe = "columns", rownames = FALSE) 11 | } 12 | -------------------------------------------------------------------------------- /tests/testthat/issues.txt: -------------------------------------------------------------------------------- 1 | #For timeseries, numeric precision can result in corrupt objects: 2 | out <- unserializeJSON(serializeJSON(AirPassengers, digits=5)) 3 | all.equal(out, AirPassengers, tolerance=1e-10) 4 | print(out) -------------------------------------------------------------------------------- /tests/testthat/readme.txt: -------------------------------------------------------------------------------- 1 | This dir contains unit tests for use with the testthat package. 2 | They are intended to be tested by a non-root user. 3 | To run them, install this package and run: 4 | 5 | library(testthat) 6 | test_package("jsonlite") 7 | -------------------------------------------------------------------------------- /tests/testthat/test-fromJSON-NA-values.R: -------------------------------------------------------------------------------- 1 | test_that("fromJSON NA values", { 2 | objects <- list( 3 | numbers = c(1, 2, NA, NaN, Inf, -Inf, 3.14), 4 | logical = c(TRUE, FALSE, NA), 5 | integers = as.integer(1, 2, 3), 6 | num = 3.14, 7 | bool = FALSE, 8 | character = c("FOO", "NA", NA, "NaN"), 9 | integer = 21L, 10 | boolNA = as.logical(NA), 11 | df = data.frame(foo = c(1, NA)) 12 | ) 13 | 14 | #test all but list 15 | lapply(objects, function(object) { 16 | expect_equal(fromJSON(toJSON(object)), object) 17 | }) 18 | 19 | #test all in list 20 | expect_equal(fromJSON(toJSON(objects)), objects) 21 | }) 22 | -------------------------------------------------------------------------------- /tests/testthat/test-fromJSON-array.R: -------------------------------------------------------------------------------- 1 | test_that("fromJSON Array, row major", { 2 | # test high dimensional arrays 3 | lapply(2:5, function(n) { 4 | object <- array(1:prod(n), dim = 1:n) 5 | newobject <- fromJSON(toJSON(object)) 6 | expect_equal(object, newobject) 7 | }) 8 | 9 | # adding some flat dimensions 10 | lapply(1:5, function(n) { 11 | object <- array(1:prod(n), dim = c(1:n, 1)) 12 | newobject <- fromJSON(toJSON(object)) 13 | expect_equal(object, newobject) 14 | }) 15 | }) 16 | 17 | test_that("fromJSON Array, column major", { 18 | # test high dimensional arrays 19 | lapply(2:5, function(n) { 20 | object <- array(1:prod(n), dim = 1:n) 21 | newobject <- fromJSON(toJSON(object, matrix = "columnmajor"), columnmajor = TRUE) 22 | expect_equal(object, newobject) 23 | }) 24 | 25 | # adding some flat dimensions 26 | lapply(1:5, function(n) { 27 | object <- array(1:prod(n), dim = c(1:n, 1)) 28 | newobject <- fromJSON(toJSON(object, matrix = "columnmajor"), columnmajor = TRUE) 29 | expect_equal(object, newobject) 30 | }) 31 | }) 32 | 33 | 34 | test_that("fromJSON Array, character strings", { 35 | # test high dimensional arrays 36 | lapply(2:5, function(n) { 37 | object <- array(paste("cell", 1:prod(n)), dim = 1:n) 38 | newobject <- fromJSON(toJSON(object, matrix = "columnmajor"), columnmajor = TRUE) 39 | expect_equal(object, newobject) 40 | }) 41 | 42 | # adding some flat dimensions 43 | lapply(1:5, function(n) { 44 | object <- array(paste("cell", 1:prod(n)), dim = c(1:n, 1)) 45 | newobject <- fromJSON(toJSON(object, matrix = "columnmajor"), columnmajor = TRUE) 46 | expect_equal(object, newobject) 47 | }) 48 | }) 49 | -------------------------------------------------------------------------------- /tests/testthat/test-fromJSON-dataframe.R: -------------------------------------------------------------------------------- 1 | options(stringsAsFactors = FALSE) 2 | 3 | test_that("recover nested data frames", { 4 | x1 <- x2 <- x3 <- x4 <- x5 <- x6 <- data.frame(foo = c(1:2)) 5 | x2$bar <- c("jeroen", "eli") 6 | x3$bar <- x4$bar <- x5$bar <- x6$bar <- data.frame(name = c("jeroen", "eli")) 7 | x4$bar$age <- x5$bar$age <- c(28, 24) 8 | x6$bar$age <- c(28, NA) 9 | x5$bar$food <- data.frame(yum = c("Rice", "Pasta")) 10 | x6$bar$food <- data.frame(yum = c(NA, "Pasta")) 11 | 12 | #add to list 13 | objects <- list(x1, x2, x3, x4, x5, x6) 14 | 15 | #test all but list 16 | lapply(objects, function(object) { 17 | expect_equal(fromJSON(toJSON(object)), object) 18 | expect_equal(fromJSON(toJSON(object, na = "null")), object) 19 | expect_equal(names(fromJSON(toJSON(object), flatten = TRUE)), names(unlist(object[1, , drop = FALSE]))) 20 | }) 21 | 22 | #test all in list 23 | expect_equal(fromJSON(toJSON(objects)), objects) 24 | }) 25 | 26 | test_that("recover lists in data frames", { 27 | x <- data.frame(author = c("Homer", "Virgil", "Jeroen")) 28 | x$poems = list(c("Iliad", "Odyssey"), c("Eclogues", "Georgics", "Aeneid"), character()) 29 | 30 | y <- data.frame(author = c("Homer", "Virgil", "Jeroen")) 31 | y$poems = list( 32 | data.frame(title = c("Iliad", "Odyssey"), year = c(-1194, -800)), 33 | data.frame(title = c("Eclogues", "Georgics", "Aeneid"), year = c(-44, -29, -19)), 34 | data.frame() 35 | ) 36 | 37 | z <- list(x = x, y = y) 38 | zz <- list(x, y) 39 | 40 | expect_equal(fromJSON(toJSON(x)), x) 41 | expect_equal(fromJSON(toJSON(y)), y) 42 | expect_equal(fromJSON(toJSON(z)), z) 43 | expect_equal(fromJSON(toJSON(zz)), zz) 44 | }) 45 | 46 | #note: nested matrix does not perfectly restore 47 | test_that("nested matrix in data frame", { 48 | x <- data.frame(foo = 1:2) 49 | x$bar <- matrix(c(1:5, NA), 2) 50 | 51 | expect_true(validate(toJSON(x))) 52 | 53 | y <- fromJSON(toJSON(x)) 54 | expect_s3_class(y, "data.frame") 55 | expect_equal(names(x), names(y)) 56 | expect_equal(length(y[[1, "bar"]]), 3) 57 | }) 58 | -------------------------------------------------------------------------------- /tests/testthat/test-fromJSON-datasets.R: -------------------------------------------------------------------------------- 1 | # Note about numeric precision 2 | # In the unit tests we use digits=10. Lowever values will result in problems for some datasets 3 | test_that("fromJSON datasets", { 4 | objects <- Filter(is.data.frame, lapply(ls("package:datasets"), get)) 5 | 6 | #data frames are never identical because: 7 | # - attributes 8 | # - factors, times, dates turn into strings 9 | # - integers turn into numeric 10 | lapply(objects, function(object) { 11 | newobject <- fromJSON(toJSON(object)) 12 | expect_s3_class(newobject, "data.frame") 13 | expect_identical(sort(names(object)), sort(names(newobject))) 14 | expect_identical(nrow(object), nrow(newobject)) 15 | }) 16 | }) 17 | -------------------------------------------------------------------------------- /tests/testthat/test-fromJSON-date.R: -------------------------------------------------------------------------------- 1 | test_that("fromJSON date objects", { 2 | x <- Sys.time() + c(1, 2, NA, 3) 3 | mydf <- data.frame(x = x) 4 | expect_s3_class(fromJSON(toJSON(x, POSIXt = "mongo")), "POSIXct") 5 | expect_equal(fromJSON(toJSON(x, POSIXt = "mongo")), x) 6 | #expect_s3_class(fromJSON(toJSON(x, POSIXt="mongo", na="string")), "POSIXct"); 7 | expect_s3_class(fromJSON(toJSON(x, POSIXt = "mongo", na = "null")), "POSIXct") 8 | 9 | expect_s3_class(fromJSON(toJSON(mydf, POSIXt = "mongo")), "data.frame") 10 | expect_s3_class(fromJSON(toJSON(mydf, POSIXt = "mongo"))$x, "POSIXct") 11 | #expect_s3_class(fromJSON(toJSON(mydf, POSIXt="mongo", na="string"))$x, "POSIXct"); 12 | expect_s3_class(fromJSON(toJSON(mydf, POSIXt = "mongo", na = "null"))$x, "POSIXct") 13 | expect_equal(fromJSON(toJSON(mydf, POSIXt = "mongo"))$x, x) 14 | 15 | xct <- as.POSIXct(x) 16 | xlt <- as.POSIXlt(x) 17 | 18 | expect_equal(xct, xlt) 19 | expect_true(unbox(xct[1]) == unbox(xlt[1])) 20 | xct3un <- unbox(xct[3]) 21 | expect_true(is.na(xct3un) && inherits(xct3un, "scalar") && inherits(xct3un, "POSIXt")) 22 | xlt3un <- unbox(xlt[3]) 23 | expect_true(is.na(xlt3un) && inherits(xlt3un, "scalar") && inherits(xlt3un, "POSIXt")) 24 | 25 | expect_equal(toJSON(xct, POSIXt = "mongo"), toJSON(xlt, POSIXt = "mongo")) 26 | expect_equal(toJSON(unbox(xct[1]), POSIXt = "mongo"), toJSON(unbox(xlt[1]), POSIXt = "mongo")) 27 | }) 28 | -------------------------------------------------------------------------------- /tests/testthat/test-fromJSON-matrix.R: -------------------------------------------------------------------------------- 1 | # Note about numeric precision 2 | # In the unit tests we use digits=10. Lowever values will result in problems for some datasets 3 | test_that("fromJSON Matrix", { 4 | objects <- list( 5 | matrix(1), 6 | matrix(1:2), 7 | matrix(1:2, nrow = 1), 8 | matrix(round(pi, 2)), 9 | matrix(c(1, NA, 2, NA), 2), 10 | volcano, 11 | matrix(NA) 12 | ) 13 | 14 | lapply(objects, function(object) { 15 | newobject <- fromJSON(toJSON(object)) 16 | expect_true(inherits(newobject, "matrix")) 17 | expect_equal(object, newobject) 18 | }) 19 | 20 | expect_equal(fromJSON(toJSON(objects)), objects) 21 | }) 22 | 23 | test_that("fromJSON Matrix with simplifyMatrix=FALSE", { 24 | expect_equal(fromJSON(toJSON(matrix(1)), simplifyMatrix = FALSE), list(1)) 25 | expect_equal(fromJSON(toJSON(matrix(1)), simplifyVector = FALSE), list(list((1)))) 26 | expect_equal(fromJSON(toJSON(matrix(NA)), simplifyMatrix = FALSE), list(NA)) 27 | expect_equal(fromJSON(toJSON(matrix(NA)), simplifyVector = FALSE), list(list((NULL)))) 28 | }) 29 | 30 | 31 | test_that("fromJSON Matrix datasets", { 32 | objects <- Filter(is.matrix, lapply(ls("package:datasets"), get)) 33 | 34 | lapply(objects, function(object) { 35 | class(object) <- "matrix" 36 | newobject <- fromJSON(toJSON(object, digits = 4)) 37 | expect_true(inherits(newobject, "matrix")) 38 | expect_equal(dim(newobject), dim(object)) 39 | attributes(newobject) <- attributes(object) 40 | 41 | # R has changed rounding algo in 4.0 and no longer matches printf 42 | #expect_equal(newobject, round(object,4)); 43 | expect_equal(newobject, object, tolerance = 1e-4) 44 | }) 45 | }) 46 | -------------------------------------------------------------------------------- /tests/testthat/test-libjson-escaping.R: -------------------------------------------------------------------------------- 1 | test_that("escaping and parsing of special characters", { 2 | #create random strings 3 | mychars <- c('a', 'b', " ", '"', "\\", "\t", "\n", "'", "/", "#", "$") 4 | createstring <- function(length) { 5 | paste(mychars[ceiling(runif(length, 0, length(mychars)))], collapse = "") 6 | } 7 | 8 | #generate 1000 random strings 9 | for (i in 1:200) { 10 | x <- createstring(i) 11 | expect_equal(x, fromJSON(toJSON(x))) 12 | expect_equal(x, fromJSON(toJSON(x, pretty = TRUE))) 13 | 14 | y <- setNames(list(123), x) 15 | expect_equal(x, fromJSON(toJSON(x, pretty = TRUE))) 16 | } 17 | }) 18 | 19 | test_that("escape solidus", { 20 | expect_equal(toJSON("foo/bar/baz"), '["foo/bar/baz"]') 21 | expect_equal(toJSON(''), '["