R/helpers.R

In ropensci/dataaimsr: AIMS Data Platform API Client

#' \code{\link[httr]{GET}} error handler
#'
#' Displays error status
#'
#' @param dt_req An URL \code{\link[httr]{GET}} output
#'
#' @details This function retrieves the status and content of \code{dt_req}
#' via the \pkg{httr} package.
#'
#' @return A \code{\link[base]{character}} vector conveying the error message.
#'
#' @author AIMS Datacentre \email{adc@aims.gov.au}
#'
#' @importFrom httr http_status content
#' @keywords internal
handle_error <- function(dt_req) {
  stop(paste("Error", http_status(dt_req), content(dt_req)))
}

#' \code{\link[jsonlite]{fromJSON}} data request
#'
#' Wrapper function
#'
#' @inherit aims_data return
#'
#' @inheritParams handle_error
#'
#' @details This function submits a \code{dt_req} data request via
#' \code{\link[jsonlite]{fromJSON}}.
#'
#' @author AIMS Datacentre \email{adc@aims.gov.au}
#'
#' @importFrom httr content
#' @importFrom jsonlite fromJSON
#' @keywords internal
json_results <- function(dt_req) {
  json_resp <- content(dt_req, "text", encoding = "UTF-8")
  fromJSON(json_resp, simplifyDataFrame = TRUE)
}

#' Format \code{\link{json_results}} output
#'
#' Wrapper function
#'
#' @inherit aims_data return
#'
#' @inheritParams handle_error
#'
#' @param next_page Logical. Is this a multi-url request?
#' @param ... Additional arguments to be passed to internal function
#' \code{\link{update_format}}
#'
#' @details This function checks for errors in \code{dt_req}
#' data request and processes result via
#' \code{\link{json_results}}.
#'
#' @author AIMS Datacentre \email{adc@aims.gov.au}
#'
#' @importFrom httr http_error
#' @keywords internal
process_request <- function(dt_req, next_page = FALSE, ...) {
  if (http_error(dt_req)) {
    handle_error(dt_req)
  } else {
    results <- json_results(dt_req)
    if (next_page && length(results$results) == 0) {
      warning("No more data")
    } else {
      results <- update_format(results, ...)
      if (!next_page) {
        message(paste("Cite this data as:", results$citation))
      }
      results
    }
  }
}

#' Expose available query filters
#'
#' Expose available query filters which are allowed to be parsed either
#' via argument \code{summary} or \code{filters} in \code{\link{aims_data}}
#'
#' @inheritParams page_data
#'
#' @author AIMS Datacentre \email{adc@aims.gov.au}
#' @keywords internal
make_base_end_pt <- function(doi, aims_version = NA) {
  base_end_pt <- getOption("dataaimsr.base_end_point")
  if (is.na(aims_version)) {
    aims_version <- getOption("dataaimsr.version")[doi]
  }
  paste0(base_end_pt, aims_version)
}

#' Format \code{\link[jsonlite]{fromJSON}} output list
#'
#' When \code{\link[jsonlite]{fromJSON}} returns a list, format list names
#'
#' @inheritParams page_data
#'
#' @param results A \code{\link[jsonlite]{fromJSON}} list
#' generated by \code{\link{json_results}}.
#'
#' @inherit aims_data return
#'
#' @author AIMS Datacentre \email{adc@aims.gov.au}
#'
#' @importFrom parsedate parse_iso_8601
#' @keywords internal
update_format <- function(results, doi) {
  if ("links" %in% names(results) &&
      "next" %in% names(results$links)) {
    results$links$next_page <- results$links$"next"
    results$links$"next" <- NULL
  }
  if ("time" %in% colnames(results$results)) {
    results$results$time <- parse_iso_8601(results$results$time)
  }
  names(results)[names(results) == "results"] <- "data"
  results
}

#' AIMS API Key retriever
#'
#' This function tries to search for an API Key
#'
#' @inheritParams page_data
#'
#' @inherit aims_data details
#'
#' @return Either a \code{\link[base]{character}} vector API Key found
#' in .Renviron or, if missing entirely, an error message.
#'
#' @author AIMS Datacentre \email{adc@aims.gov.au}
#' @keywords internal
find_api_key <- function(api_key) {
  if (is.null(api_key)) {
    r_env_api_key <- Sys.getenv("AIMS_DATAPLATFORM_API_KEY")
    if (is.null(r_env_api_key)) {
      stop("No API Key could be found, please see",
           "https://open-aims.github.io/data-platform/key-request")
    } else {
      r_env_api_key
    }
  } else {
    api_key
  }
}

#' AIMS Dataset DOI retriever
#'
#' Returns DOI for a given dataset
#'
#' @param target A \code{\link[base]{character}} vector of length 1 specifying
#' the dataset. Only \code{weather} or \code{temp_loggers} are currently
#' allowed.
#'
#' @return A \code{\link[base]{character}} vector
#' containing the dataset DOI string.
#'
#' @author AIMS Datacentre \email{adc@aims.gov.au}
#'
#' @examples
#' \dontrun{
#' library(dataaimsr)
#' weather_doi <- data_doi("weather")
#' ssts_doi <- data_doi("temp_loggers")
#' }
#' @keywords internal
data_doi <- function(target) {
  if (!(target %in% c("weather", "temp_loggers"))) {
    stop("Wrong type of data target, only \"weather\"",
         "or \"temp_loggers\" are allowed")
  }
  getOption(paste0("dataaimsr.", target))
}

#' make_pretty_data_label
#'
#' Internal
#'
#' @param x A character
#' @keywords internal
make_pretty_data_label <- function(x) {
  ifelse(x == "weather", "Weather Station", "Temperature loggers")
}

#' make_pretty_colour
#'
#' Internal
#'
#' @param x A character
#' @param alpha_ A numeric
#'
#' @importFrom grDevices col2rgb rgb
#' @keywords internal
make_pretty_colour <- function(x, alpha_ = 0.55) {
  col <- col2rgb(x)
  rgb(col[1], col[2], col[3], alpha = alpha_ * 255, maxColorValue = 255)
}

#' capitalise
#'
#' Internal
#'
#' @param x A character
#' @keywords internal
capitalise <- function(x) {
  paste0(toupper(substr(x, 1, 1)), substr(x, 2, nchar(x)))
}

#' extract_map_coord
#'
#' Internal
#'
#' @param x An sfc_POINT
#' @param ... Additional argument "pos" to internal function
#' @keywords internal
extract_map_coord <- function(x, ...) {
  sapply(x, function(z, pos)z[[pos]], ...)
}