R/expect-json.R

In httptest: A Test Environment for HTTP Requests

#' Test that objects would generate equivalent JSON
#'
#' Named lists in R are ordered, but they translate to unordered objects in
#' JSON. This test expectation loosens the equality check of two objects to
#' ignore the order of elements in a named list.
#' @param object object to test
#' @param expected expected value
#' @param info extra information to be included in the message
#' @param label character name by which to refer to `object` in the test
#' result. Because the tools for deparsing object names that 'testthat' uses
#' aren't exported from that package, the default here is just "object".
#' @param expected.label character same as `label` but for `expected`
#' @return Invisibly, returns `object` for optionally passing to other
#' expectations.
#' @seealso [testthat::expect_equivalent()]
#' @importFrom testthat expect
#' @export
expect_json_equivalent <- function(object,
                                   expected,
                                   info = NULL,
                                   label = "object",
                                   expected.label = "expected") {
  comp <- json_compare(object, expected, check.attributes = FALSE)
  expect(comp$equal, sprintf(
    "%s not JSON-equivalent to %s.\n%s",
    label, expected.label, comp$message
  ), info = info)
  invisible(object)
}

#' @importFrom testthat compare
json_compare <- function(object, expected, check.attributes = FALSE) {
  compare(object_sort(object), object_sort(expected),
    check.attributes = check.attributes
  )
}

object_sort <- function(x) {
  if (is.list(x)) {
    x <- as.list(x) # For S4 subclasses
    if (!is.null(names(x))) {
      x <- x[sort(names(x))]
    }
    return(lapply(x, object_sort))
  }
  return(x)
}