Fix bugs, remove dead code, and deduplicate shared patterns

R/AAA.R

@@ -90,20 +90,6 @@ wqp_message_beta <- function() {
   message("WQX3 services are in-development, use with caution.")
 }
 
-only_legacy <- function(service) {
-  legacy <- service %in%
-    c(
-      "Organization",
-      "ActivityMetric",
-      "SiteSummary",
-      "Project",
-      "ProjectMonitoringLocationWeighting",
-      "ResultDetectionQuantitationLimit",
-      "BiologicalMetric"
-    )
-  return(legacy)
-}
-
 is_legacy <- function(service) {
   legacy <- service %in%
     c(

R/constructNWISURL.R

@@ -144,26 +144,6 @@ constructNWISURL <- function(
         url <- get_or_post(url, POST = POST, end_date = endDate)
       }
     },
-    measurements = {
-      url <- get_or_post(
-        baseURL,
-        POST = POST,
-        site_no = siteNumbers,
-        .multi = "comma"
-      )
-      url <- get_or_post(url, POST = POST, range_selection = "date_range")
-      if (nzchar(startDate)) {
-        url <- get_or_post(url, POST = POST, begin_date = startDate)
-      }
-      if (nzchar(endDate)) {
-        url <- get_or_post(url, POST = POST, end_date = endDate)
-      }
-      if (expanded) {
-        url <- get_or_post(url, POST = POST, format = "rdb_expanded")
-      } else {
-        url <- get_or_post(url, POST = POST, format = "rdb")
-      }
-    },
     stat = {
       # for statistics service
 

R/construct_api_requests.R

@@ -385,11 +385,9 @@ format_api_dates <- function(datetime, date = FALSE) {
       }
       datetime <- paste0(datetime, collapse = "/")
     } else {
-      for (i in seq_along(datetime)) {
-        datetime1 <- get_dateTime(datetime)
-      }
+      datetime1 <- lapply(datetime, get_dateTime)
       datetime <- paste0(
-        lubridate::format_ISO8601(datetime1, usetz = "Z"),
+        vapply(datetime1, lubridate::format_ISO8601, character(1), usetz = "Z"),
         collapse = "/"
       )
     }
@@ -599,12 +597,16 @@ basic_request <- function(url_base, format = "json") {
     httr2::req_error(body = error_body) |>
     httr2::req_timeout(seconds = 180)
 
-  token <- Sys.getenv("API_USGS_PAT")
+  req <- add_api_token(req)
+
+  return(req)
+}
 
+add_api_token <- function(req) {
+  token <- Sys.getenv("API_USGS_PAT")
   if (token != "") {
     req <- req |>
       httr2::req_headers_redacted(`X-Api-Key` = token)
   }
-
-  return(req)
+  req
 }

R/getWebServiceData.R

@@ -98,6 +98,10 @@ check_non_200s <- function(returnedList) {
 #'
 #' @keywords internal
 default_ua <- function() {
+  if (!is.null(pkg.env$ua)) {
+    return(pkg.env$ua)
+  }
+
   versions <- c(
     libcurl = curl::curl_version()$version,
     httr2 = as.character(utils::packageVersion("httr2")),
@@ -110,6 +114,7 @@ default_ua <- function() {
     ua <- paste0(ua, "/", Sys.getenv("CUSTOM_DR_UA"))
   }
 
+  pkg.env$ua <- ua
   return(ua)
 }
 

R/importWQP.R

@@ -276,23 +276,3 @@ create_dateTime <- function(df, date_col, time_col, tz_col, tz) {
   return(df)
 }
 
-post_url <- function(obs_url, csv = FALSE) {
-  split <- strsplit(obs_url, "?", fixed = TRUE)
-
-  url <- split[[1]][1]
-  if (csv) {
-    url <- paste0(url, "?mimeType=csv")
-  } else {
-    url <- paste0(url, "?mimeType=tsv")
-  }
-
-  if (grepl("sorted", split[[1]][2])) {
-    url <- paste0(
-      url,
-      "&sorted=",
-      strsplit(split[[1]][2], "sorted=", fixed = TRUE)[[1]][2]
-    )
-  }
-
-  return(url)
-}

R/readNGWMNdata.R

@@ -50,9 +50,6 @@ readNGWMNdata <- function(service, ..., asDateTime = TRUE, tz = "UTC") {
   match.arg(service, c("observation", "featureOfInterest"))
 
   if (service == "observation") {
-    allObs <- data.frame()
-    allAttrs <- data.frame()
-
     # these attributes are pulled out and saved when doing binds to be reattached
     attrs <- c(
       "url",
@@ -63,13 +60,17 @@ readNGWMNdata <- function(service, ..., asDateTime = TRUE, tz = "UTC") {
     )
     featureID <- stats::na.omit(gsub(":", ".", dots[["siteNumbers"]]))
 
-    for (f in featureID) {
-      obsFID <- retrieveObservation(featureID = f, asDateTime, attrs, tz = tz)
-      obsFIDattr <- saveAttrs(attrs, obsFID)
-      obsFID <- removeAttrs(attrs, obsFID)
-      allObs <- r_bind_dr(allObs, obsFID)
-      allAttrs <- r_bind_dr(allAttrs, obsFIDattr)
+    obs_list <- vector("list", length(featureID))
+    attr_list <- vector("list", length(featureID))
+    for (idx in seq_along(featureID)) {
+      obsFID <- retrieveObservation(
+        featureID = featureID[idx], asDateTime, attrs, tz = tz
+      )
+      attr_list[[idx]] <- saveAttrs(attrs, obsFID)
+      obs_list[[idx]] <- removeAttrs(attrs, obsFID)
     }
+    allObs <- Reduce(r_bind_dr, obs_list, init = data.frame())
+    allAttrs <- Reduce(r_bind_dr, attr_list, init = data.frame())
 
     allSites <- tryCatch(
       {

R/readNWISunit.R

@@ -287,9 +287,6 @@ readNWISrating <- function(siteNumber, type = "base", convertType = TRUE) {
   data <- importRDB1(url, asDateTime = FALSE, convertType = convertType)
 
   if ("current_rating_nu" %in% names(data)) {
-    intColumns <- intColumns[
-      !("current_rating_nu" %in% names(data)[intColumns])
-    ]
     data$current_rating_nu <- gsub(" ", "", data$current_rating_nu)
   }
 
@@ -480,9 +477,3 @@ readNWISuse <- function(
   return(NULL)
 }
 
-.capitalALL <- function(input) {
-  if (any(grepl("(?i)all", input))) {
-    input <- toupper(input)
-  }
-  return(input)
-}

R/read_waterdata_samples.R

@@ -129,14 +129,8 @@ construct_waterdata_sample_request <- function(
 
   baseURL <- httr2::request("https://api.waterdata.usgs.gov") |>
     httr2::req_url_path_append("samples-data") |>
-    httr2::req_url_query(mimeType = "text/csv")
-
-  token <- Sys.getenv("API_USGS_PAT")
-
-  if (token != "") {
-    baseURL <- baseURL |>
-      httr2::req_headers_redacted(`X-Api-Key` = token)
-  }
+    httr2::req_url_query(mimeType = "text/csv") |>
+    add_api_token()
 
   switch(
     dataType,
@@ -387,14 +381,8 @@ check_waterdata_sample_params <- function(
   match.arg(service, choices = service_options, several.ok = FALSE)
 
   check_group_req <- httr2::request("https://api.waterdata.usgs.gov") |>
-    httr2::req_url_path_append("samples-data")
-
-  token <- Sys.getenv("API_USGS_PAT")
-
-  if (token != "") {
-    check_group_req <- check_group_req |>
-      httr2::req_headers_redacted(`X-Api-Key` = token)
-  }
+    httr2::req_url_path_append("samples-data") |>
+    add_api_token()
 
   if (service != "reference-list") {
     check_group_req <- check_group_req |>
@@ -544,14 +532,8 @@ summarize_waterdata_samples <- function(monitoringLocationIdentifier) {
   baseURL <- httr2::request("https://api.waterdata.usgs.gov") |>
     httr2::req_url_path_append("samples-data") |>
     httr2::req_url_path_append("summary", monitoringLocationIdentifier) |>
-    httr2::req_url_query(mimeType = "text/csv")
-
-  token <- Sys.getenv("API_USGS_PAT")
-
-  if (token != "") {
-    baseURL <- baseURL |>
-      httr2::req_headers_redacted(`X-Api-Key` = token)
-  }
+    httr2::req_url_query(mimeType = "text/csv") |>
+    add_api_token()
 
   df <- importWQP(baseURL)
 
@@ -567,66 +549,20 @@ summarize_waterdata_samples <- function(monitoringLocationIdentifier) {
 }
 
 
-#' @rdname read_waterdata_samples
+#' @title Deprecated: Use \code{read_waterdata_samples} instead
+#' @description This function has been renamed to \code{\link{read_waterdata_samples}}.
+#' @param ... Arguments passed to \code{\link{read_waterdata_samples}}.
+#' @return data frame returned from web service call.
 #' @export
-read_USGS_samples <- function(
-  monitoringLocationIdentifier = NA,
-  siteTypeCode = NA,
-  boundingBox = NA,
-  hydrologicUnit = NA,
-  activityMediaName = NA,
-  characteristicGroup = NA,
-  characteristic = NA,
-  characteristicUserSupplied = NA,
-  activityStartDateLower = NA,
-  activityStartDateUpper = NA,
-  countryFips = NA,
-  stateFips = NA,
-  countyFips = NA,
-  projectIdentifier = NA,
-  recordIdentifierUserSupplied = NA,
-  siteTypeName = NA,
-  usgsPCode = NA,
-  pointLocationLatitude = NA,
-  pointLocationLongitude = NA,
-  pointLocationWithinMiles = NA,
-  dataType = "results",
-  dataProfile = NA,
-  tz = "UTC",
-  convertType = TRUE
-) {
+#' @keywords internal
+read_USGS_samples <- function(...) {
   .Deprecated(
     new = "read_waterdata_samples",
     package = "dataRetrieval",
     msg = "Function has been renamed. Please begin to migrate to read_waterdata_samples"
   )
 
-  read_waterdata_samples(
-    monitoringLocationIdentifier = monitoringLocationIdentifier,
-    siteTypeCode = siteTypeCode,
-    boundingBox = boundingBox,
-    hydrologicUnit = hydrologicUnit,
-    activityMediaName = activityMediaName,
-    characteristicGroup = characteristicGroup,
-    characteristic = characteristic,
-    characteristicUserSupplied = characteristicUserSupplied,
-    activityStartDateLower = activityStartDateLower,
-    activityStartDateUpper = activityStartDateUpper,
-    countryFips = countryFips,
-    stateFips = stateFips,
-    countyFips = countyFips,
-    projectIdentifier = projectIdentifier,
-    recordIdentifierUserSupplied = recordIdentifierUserSupplied,
-    siteTypeName = siteTypeName,
-    usgsPCode = usgsPCode,
-    pointLocationLatitude = pointLocationLatitude,
-    pointLocationLongitude = pointLocationLongitude,
-    pointLocationWithinMiles = pointLocationWithinMiles,
-    dataType = dataType,
-    dataProfile = dataProfile,
-    tz = tz,
-    convertType = convertType
-  )
+  read_waterdata_samples(...)
 }
 
 

R/read_waterdata_stats.R

@@ -163,12 +163,7 @@ construct_statistics_request <- function(service = "Normals") {
     httr2::req_url_path_append(getOption("dataRetrieval.api_version_stat")) |>
     httr2::req_url_path_append(paste0("observation", service))
 
-  token <- Sys.getenv("API_USGS_PAT")
-
-  if (token != "") {
-    base_request <- base_request |>
-      httr2::req_headers_redacted(`X-Api-Key` = token)
-  }
+  base_request <- add_api_token(base_request)
 
   return(base_request)
 }