R/utils.R

#' Make a request to Quandl
#'
#' Responses returned as text to be parsed further.
#' Automatically retries up to 3 times.
#' Errors are parsed and returned nicely.
#'
#' @return <`response`>
#'
#' @noRd
#' @keywords internal
quandl_api <- function(
  path,
  type    = c("csv", "json", "xml"),
  query   = NULL,
  ...,
  api_key = quandl_key_get()
) {

  type   <- rlang::arg_match(type)
  if (type == "xml") stop("Type `xml` currently unsupported.")

  # set API and client info as headers
  headers <- c(
    `Request-Source`         = 'R',
    `Request-Source-Version` = paste0("tidyquandl_", utils::packageVersion("tidyquandl")),
    `X-Api-Token`            = api_key
  )

  # collapse multi-value paramters
  if (!is.null(query)) query <- lapply(query, paste, collapse = ",")

  # fetch result from Quandl
  # will retry for HTTP errors (400+)
  response <- httr::RETRY(
    "GET",
    url   = glue::glue("https://www.quandl.com/api/v3/{path}.{type}"),
    query = query,
    httr::add_headers(.headers = headers),
    ...
  )

  # error on http codes 400+
  if (httr::http_error(response)) {
    stop(build_error_message(
      httr::content(response, as = "text"),
      httr::http_type(response),
      httr::status_code(response)
    ))
  }

  response
}


#' Build error message by parsing content
#'
#' @noRd
#' @keywords internal
build_error_message <- function(content, type = c("text/csv", "application/json"), status_code) {

  type <- rlang::arg_match(type)

  # parse error into list/tibble with names "code", "message"
  quandl <- switch(
    type,
    "text/csv"         = readr::read_csv(content, col_types = "cc"),
    "application/json" = jsonlite::fromJSON(content)[[1]]
  )

  msg <- glue::glue(
    "{quandl$message}",
    "Quandl Error Code: {quandl$code}",
    "HTTP Status Code: {status_code}",
    .sep = "\n"
  )

  msg
}


#' Split a set of parameters into batches
#'
#' @noRd
#' @keywords internal
batch_parameters <- function(params, batch_size) {

  # if not batching, wrap in list
  if (is.null(batch_size) || all(lengths(params) <= batch_size)) {
    return(list(params))
  }

  # separate into short / long groups of paramters
  short_params <- params[lengths(params) <= batch_size]
  long_params <- params[lengths(params) > batch_size]

  if (length(long_params) > 1) {
    stop("Batching over multiple parameters not yet supported.")
  }

  # split long parameter
  long_param <- long_params[[1]]
  long_param_batches <- rlang::set_names(split(long_param, ceiling(seq_along(long_param) / batch_size)), NULL)

  # return list of batches
  purrr::map(long_param_batches, ~ c(short_params, rlang::set_names(list(.x), names(long_params))))
}


#' Fetch all results by following cursor_id in response header
#'
#' @noRd
#' @keywords internal
fetch_all_results <- function(params, path) {
  responses = list()

  while (TRUE) {
    response <- quandl_api(path, "csv", params)
    responses <- c(responses, list(response))

    cursor_id <- httr::headers(response)$cursor_id

    if (rlang::is_null(cursor_id)) break

    params$qopts.cursor_id <- cursor_id
  }

  responses
}


#' Translate Quandl-provided types to readr-compatible column spec
#' type_tbl should be from e.g. quandl_datatable_meta("WIKI/PRICES")$columns
#'
#' @noRd
#' @keywords internal
convert_col_spec <- function(type_tbl) {

  types <- stringr::str_to_lower(type_tbl$type)

  funcs <- dplyr::case_when(
    stringr::str_detect(types, "^float|^bigdecimal|^double") ~ list(readr::col_double()),
    stringr::str_detect(types, "^integer")                   ~ list(readr::col_integer()),
    stringr::str_detect(types, "^datetime")                  ~ list(readr::col_datetime()),
    stringr::str_detect(types, "^date")                      ~ list(readr::col_date()),
    TRUE                                                     ~ list(readr::col_character())
  ) %>%
    rlang::set_names(type_tbl$name)

  purrr::lift_dl(readr::cols)(funcs)
}
ClaytonJY/tidyquandl documentation built on May 3, 2019, 4:02 p.m.