R/assertions.R

In riingo: An R Interface to the 'Tiingo' Stock Price API

# ------------------------------------------------------------------------------
# Assertions

assert_x_is_length <- function(x, x_name, length) {
  l <- length(x)
  is_correct_length <- l == length
  if(!is_correct_length) {
    glue_stop("{x_name} must be length {yellow('1')}, but is actually length {green(l)}.")
  }
}

assert_x_inherits <- function(x, x_name, class) {
  has_class <- inherits(x, class)
  if(!has_class) {
    classes <- glue::glue_collapse(green(class(x)), ", ")
    correct_class <- yellow(class)
    glue_stop("{x_name} must be {correct_class}. You have passed in a: {classes}")
  }
}

assert_x_inherits_one_of <- function(x, x_name, classes) {
  has_one_of_classes <- any(class(x) %in% classes)
  if(!has_one_of_classes) {
    x_classes <- glue::glue_collapse(green(class(x)), ", ")
    correct_classes <- glue::glue_collapse(yellow(classes), ", ",  last = ", or ")
    glue_stop("{x_name} must be {correct_classes}. You have passed in a: {x_classes}")
  }
}

assert_valid_response <- function(ticker, resp) {
  status <- resp$status_code

  if(status != 200) {
    # only get the content() if there was a problem
    resp_content <- httr::content(resp, as = "text", encoding = "UTF-8")
    server_error <- tryCatch({
      jsonlite::fromJSON(resp_content)
    },
    error = function(e) {
      # See #4 riingo_iex_latest("BRK.A"), HTML returned as text, not parsable JSON
      resp_content
    })
  }

  if(status == 404) {
    msg <- paste0("The ticker name, {green(ticker)}, is invalid or data is currently not available. ",
                  "Check ticker validity with {yellow('is_supported_ticker()')}.")
    msg_tiingo <- paste0("Tiingo msg) ", server_error)
    glue_stop(msg, "\n", msg_tiingo)
  }

  if(status == 400) {
    msg <- paste0("A parameter might be malformed. See the Tiingo msg.")
    msg_tiingo <- paste0("Tiingo msg) ", server_error)
    glue_stop(msg, "\n", msg_tiingo)
  }

  # Hopefully catch other errors
  if(status != 200) {
    msg <- paste0("There was an error, but riingo isn't sure why. See Tiingo msg for details.")
    msg_tiingo <- paste0("Tiingo msg) ", server_error)
    glue_stop(msg, "\n", msg_tiingo)
  }
}

assert_valid_content <- function(ticker, cont) {
  if (!identical(cont, list())) {
    return(invisible())
  }

  glue_stop(
    "No error was thrown by Tiingo for {green(ticker)}, but no content was returned. \n",
    "Are you sure this is a valid ticker? Check this with {yellow('is_supported_ticker()')}. \n",
    "Alternatively, you might be outside the valid date range."
  )
}

# Check all of the arguments at once
assert_valid_argument_inheritance <- function(ticker, start_date, end_date, resample_frequency) {
  assert_x_inherits(ticker, "ticker", class = "character")
  assert_x_inherits_one_of(start_date, "start_date", c("NULL", "character", "Date", "POSIXct"))
  assert_x_inherits_one_of(end_date, "end_date", c("NULL", "character", "Date", "POSIXct"))
  assert_x_inherits(resample_frequency, "resample_frequency", "character")
}

assert_resample_freq_is_granular <- function(resample_frequency) {
  valid_freq <- c("daily", "weekly", "monthly", "annually")

  is_valid_freq <- resample_frequency %in% valid_freq

  if(!is_valid_freq) {
    user_freq <- green(resample_frequency)
    correct_freq <- glue::glue_collapse(yellow(valid_freq), ", ", last = ", or ")
    glue_stop("resample_frequency must be {correct_freq}. You have passed in: {user_freq}")
  }
}

assert_resample_freq_is_fine <- function(resample_frequency) {
  valid_base <- c("min", "hour")
  has_valid_base <- any(purrr::map_lgl(valid_base, ~grepl(.x, resample_frequency)))

  if(!has_valid_base) {
    user_freq <- green(resample_frequency)
    correct_base <- glue::glue_collapse(yellow(valid_base), ", or ")
    correct_freq <- glue::glue_collapse(yellow(c("1min", "5min", "1hour")), ", ", last = ", or ")
    glue_stop("resample_frequency is only valid for {correct_base}, and must be formatted similar to {correct_freq}. ",
              "You have passed in: {user_freq}.")
  }
}

assert_resample_freq_is_crypto <- function(resample_frequency) {
  valid_base <- c("min", "hour", "day")
  has_valid_base <- any(purrr::map_lgl(valid_base, ~grepl(.x, resample_frequency)))

  if(!has_valid_base) {
    user_freq <- green(resample_frequency)
    correct_base <- glue::glue_collapse(yellow(valid_base), ", or ")
    correct_freq <- glue::glue_collapse(yellow(c("1min", "5min", "1hour", "2day")), ", ", last = ", or ")
    glue_stop("resample_frequency is only valid for {correct_base}, and must be formatted similar to {correct_freq}. ",
              "You have passed in: {user_freq}.")
  }
}