R/coco_stations.R

In rywhale/cocorahsR:

#' coco_stations
#'
#' @description Retrieves CoCoRaHS station metadata.
#' @param country Filter stations based on country. Options are
#' \describe{
#'  \item{can}{Canada}
#'  \item{usa}{United States}
#'  \item{bhs}{Bahamas}
#' }
#' @param state Filter stations based on state (United States only)
#' @param county Filter stations based on county (United States only)
#' @return Tibble with CoCoRaHS station metadata. Columns are
#' \describe{
#'  \item{st_num}{Unique station identifier assigned by CoCoRaHS}
#'  \item{st_name}{Station name assigned by CoCoRaHS}
#'  \item{lat}{Station latitude}
#'  \item{lng}{Station longitude}
#'  \item{elev}{Station elevation (masl)}
#' }
#' @export
#'

coco_stations <- function(country, state, county) {
  # Base query setup
  base_url <- "http://data.cocorahs.org/cocorahs/export/exportstations.aspx?"
  api_query <- list(
    "format" = "json"
  )

  # Require country
  if (missing(country)) {
    stop(
      "Must provide a country for filtering. See ?coco_stations for options"
    )
  }

  api_query[["country"]] <- country

  if (!missing(state)) {
    if (country == "usa") {
      api_query[["state"]] <- state
    } else {
      stop(
        "'state' filter only available for stations in United States."
      )
    }
  }

  if (!missing(county)) {
    if (country == "usa" & !missing(state)) {
      api_query[["county"]] <- county
    } else {
      stop(
        "'county' filter only available when also using 'state' filter."
      )
    }
  }

  req <- tryCatch({
    httr::GET(
      url = base_url,
      query = api_query
    )
  }, error = function(e) {
    return(e)
  })

  req_raw <- httr::content(req, "text")

  # Break into lines (malformed JSON)
  req_lns <- readLines(
    textConnection(req_raw)
  )

  # Find query returned query status
  status_chunk <- req_lns[stringr::str_detect(req_lns, "status")]

  # Check for success (typo intentional)
  if (!stringr::str_detect(status_chunk, "sucess")) {
    stop("Query returned error.")
  }

  # Parse all lines with station metadata
  req_parsed <- purrr::map(
    req_lns[stringr::str_detect(req_lns, "id")],
    function(id_line) {
      # Remove trailing comma
      id_line <- stringr::str_replace(
        id_line, ",$", ""
      )
      return(jsonlite::fromJSON(id_line))
    }
  )

  # To table then out
  req_tab <- dplyr::bind_rows(
    req_parsed
  )

  return(tibble::as_tibble(req_tab[, -1]))
}