diff --git a/DESCRIPTION b/DESCRIPTION index afaebf4..7d218a1 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -27,9 +27,9 @@ License: MIT + file LICENSE Encoding: UTF-8 LazyData: true Roxygen: list(markdown = TRUE) -RoxygenNote: 7.2.2 +RoxygenNote: 7.3.2 Imports: - jsonlite, + rjson, httr, rlang, purrr, diff --git a/R/xronos-api.R b/R/xronos-api.R index 2dd6e0e..ced508f 100644 --- a/R/xronos-api.R +++ b/R/xronos-api.R @@ -88,29 +88,71 @@ xronos_query <- function(filter, values) { #' @noRd xronos_parse <- function(response) { content <- httr::content(response, as = "text") - result <- jsonlite::parse_json(content) - - # Flatten nested attributes - result <- purrr::map_depth(result, 2, - ~purrr::map_at(., c("measurement", "periods"), - ~list(unlist(., use.names = FALSE)))) - result <- purrr::map_depth(result, 2, - ~purrr::map_at(., c("measurement", "typochronological_units"), - ~list(unlist(., use.names = FALSE)))) - result <- purrr::map_depth(result, 2, - ~purrr::map_at(., c("measurement", "ecochronological_units"), - ~list(unlist(., use.names = FALSE)))) - - # Normalise & rectangle - result <- purrr::map(result, normalise_empty) - result <- purrr::map_dfr(result, "measurement") - - result + result <- rjson::fromJSON(content) + + measurements <- lapply(seq_along(result), function(i) { + process_measurement(result[[i]]$measurement) + }) + + # Combine list of named lists into a data frame and then convert to tibble + result_df <- dplyr::bind_rows(measurements) + + result_df <- lapply(result_df, normalise_empty) + + return(dplyr::as_tibble(result_df)) } # Helpers ----------------------------------------------------------------- +#' XRONOS web address +#' +#' Helper function to process each measurement +#' +#' @param measurement An individual measurement from the response as JSON +#' +#' @return +#' A row of parsed JSON for an individual measurement. +#' @keywords internal +#' @noRd +process_measurement <- function(measurement) { + + periods <- unlist( + lapply( + measurement$periods, + function(x) x$periode + ), + use.names = FALSE) + + typochronological_units <- unlist( + lapply( + measurement$typochronological_units, + function(x) x$typochronological_unit + ), + use.names = FALSE + ) + + ecochronological_units <- unlist( + lapply( + measurement$ecochronological_units, + function(x) x$ecochronological_unit + ), + use.names = FALSE + ) + + reference <- lapply( + measurement$reference, + function(x) list(reference = x$reference) + ) + + measurement$periods <- list(periods) + measurement$typochronological_units <- list(typochronological_units) + measurement$ecochronological_units <- list(ecochronological_units) + measurement$reference <- reference + + return(measurement) +} + #' XRONOS web address #' #' Returns the current base URL of XRONOS, or the address of the API version @@ -175,9 +217,10 @@ xronos_assert_valid_filter <- function(x) { #' @noRd normalise_empty <- function(x) { if (is.list(x)) { - if (length(x) == 0) NA - else purrr::map(x, normalise_empty) + lapply(x, normalise_empty) + } else if (is.null(x)) { + NA + } else { + x } - else if (is.null(x)) NA - else x } diff --git a/xronos.Rproj b/xronos.Rproj index 270314b..5131c92 100644 --- a/xronos.Rproj +++ b/xronos.Rproj @@ -1,4 +1,5 @@ Version: 1.0 +ProjectId: dde9acba-558b-41ef-ac0d-d54b8e2d9578 RestoreWorkspace: Default SaveWorkspace: Default