From 030edf4b239d71d9525a7f9adc0ef0cac311b404 Mon Sep 17 00:00:00 2001 From: Laura A DeCicco Date: Wed, 23 Oct 2024 16:26:36 -0500 Subject: [PATCH 01/30] First steps in switching to httr2 --- DESCRIPTION | 5 +- R/constructNWISURL.R | 244 ++++++++++++++++++++++------------------ R/getWebServiceData.R | 101 ++++++----------- R/importRDB1.R | 43 ++++--- R/importWaterML1.R | 1 + R/readNWISdv.R | 1 + R/readNWISsite.R | 16 +-- man/constructNWISURL.Rd | 7 +- 8 files changed, 200 insertions(+), 218 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index e879a86b..3086ab62 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: dataRetrieval Type: Package Title: Retrieval Functions for USGS and EPA Hydrology and Water Quality Data -Version: 2.7.17 +Version: 2.7.17.1 Authors@R: c( person("Laura", "DeCicco", role = c("aut","cre"), email = "ldecicco@usgs.gov", @@ -46,7 +46,8 @@ Imports: utils, xml2, readr (>= 1.4.0), - jsonlite + jsonlite, + httr2 Suggests: covr, dplyr, diff --git a/R/constructNWISURL.R b/R/constructNWISURL.R index e7f84a33..cbfaabf0 100644 --- a/R/constructNWISURL.R +++ b/R/constructNWISURL.R @@ -1,11 +1,6 @@ #' Construct NWIS url for data retrieval #' -#' Imports data from NWIS web service. This function gets the data from here: -#' \url{https://nwis.waterdata.usgs.gov/nwis/qwdata} -#' A list of parameter codes can be found here: -#' \url{https://nwis.waterdata.usgs.gov/nwis/pmcodes/} -#' A list of statistic codes can be found here: -#' \url{https://nwis.waterdata.usgs.gov/nwis/help/?read_file=stat&format=table} +#' Using USGS water web services to construct urls. #' #' @param siteNumbers string or vector of strings USGS site number. This is usually an 8 digit number #' @param parameterCd string or vector of USGS parameter code. This is usually an 5 digit number. @@ -81,6 +76,7 @@ constructNWISURL <- function(siteNumbers, ratingType = "base", statReportType = "daily", statType = "mean") { + service <- match.arg(service, c( "dv", "uv", "iv", "iv_recent", "qw", "gwlevels", "rating", "peak", "meas", "stat", "qwdata" @@ -90,6 +86,8 @@ constructNWISURL <- function(siteNumbers, service[service == "meas"] <- "measurements" service[service == "uv"] <- "iv" + baseURL <- httr2::request(pkg.env[[service]]) + if (any(!is.na(parameterCd) & parameterCd != "all")) { pcodeCheck <- all(nchar(parameterCd) == 5) & all(!is.na(suppressWarnings(as.numeric(parameterCd)))) @@ -104,99 +102,106 @@ constructNWISURL <- function(siteNumbers, } multipleSites <- length(siteNumbers) > 1 - - siteNumbers <- paste(siteNumbers, collapse = ",") - - baseURL <- drURL(service, Access = pkg.env$access) + multiplePcodes <- length(parameterCd) > 1 switch(service, qwdata = { if (multipleSites) { searchCriteria <- "multiple_site_no" - url <- appendDrURL(baseURL, multiple_site_no = siteNumbers) + url <- httr2::req_url_query(baseURL, + multiple_site_no = siteNumbers, + .multi = "comma") } else { searchCriteria <- "search_site_no" - url <- appendDrURL(baseURL, - search_site_no = siteNumbers, - search_site_no_match_type = "exact" - ) + url <- httr2::req_url_query(baseURL, + search_site_no = siteNumbers, + .multi = "comma") + url <- httr2::req_url_query(baseURL, + search_site_no_match_type = "exact") } - multiplePcodes <- length(parameterCd) > 1 - if (multiplePcodes) { - pCodes <- paste(parameterCd, collapse = ",") - url <- appendDrURL(url, - multiple_parameter_cds = pCodes, - param_cd_operator = "OR" - ) + url <- httr2::req_url_query(url, + multiple_parameter_cds = parameterCd, + .multi = "comma") + url <- httr2::req_url_query(url, param_cd_operator = "OR") } else { - url <- appendDrURL(url, - multiple_parameter_cds = parameterCd, - param_cd_operator = "AND" - ) + url <- httr2::req_url_query(url, + multiple_parameter_cds = parameterCd) + url <- httr2::req_url_query(url, param_cd_operator = "AND") } searchCriteria <- paste(searchCriteria, "multiple_parameter_cds", sep = ",") - url <- appendDrURL(url, list_of_search_criteria = searchCriteria) + url <- httr2::req_url_query(url, + list_of_search_criteria = searchCriteria) + params <- list(group_key = "NONE", + sitefile_output_format = "html_table", + column_name = "agency_cd", + column_name = "site_no", + column_name = "station_nm", + inventory_output = "0", + rdb_inventory_output = "file", + TZoutput = "0", + pm_cd_compare = "Greater%20than", + radio_parm_cds = "previous_parm_cds", + qw_attributes = "0", + format = "rdb", + date_format = "YYYY-MM-DD", + rdb_compression = "value") + url <- httr2::req_url_query(url, !!!params ) - url <- paste(url, "group_key=NONE&sitefile_output_format=html_table&column_name=agency_cd", - "column_name=site_no&column_name=station_nm&inventory_output=0&rdb_inventory_output=file", - "TZoutput=0&pm_cd_compare=Greater%20than&radio_parm_cds=previous_parm_cds&qw_attributes=0", - "format=rdb&rdb_qw_attributes=0&date_format=YYYY-MM-DD", - "rdb_compression=value", - sep = "&" - ) if (expanded) { - url <- appendDrURL(url, qw_sample_wide = "0") - url <- gsub("rdb_qw_attributes=0", "rdb_qw_attributes=expanded", url) + url <- httr2::req_url_query(url, qw_sample_wide = "0") + url <- httr2::req_url_query(url, rdb_qw_attributes= "expanded") } else { - url <- appendDrURL(url, qw_sample_wide = "separated_wide") + url <- httr2::req_url_query(url, rdb_qw_attributes = "0") + url <- httr2::req_url_query(url, qw_sample_wide = "separated_wide") } if (nzchar(startDate)) { - url <- appendDrURL(url, begin_date = startDate) + url <- httr2::req_url_query(url, begin_date = startDate) } if (nzchar(endDate)) { - url <- appendDrURL(url, end_date = endDate) + url <- httr2::req_url_query(url, end_date = endDate) } }, rating = { ratingType <- match.arg(ratingType, c("base", "corr", "exsa")) - url <- appendDrURL(baseURL, site_no = siteNumbers, file_type = ratingType) + url <- httr2::req_url_query(baseURL, + site_no = siteNumbers, + file_type = ratingType) }, peak = { - url <- appendDrURL(baseURL, + url <- httr2::req_url_query(baseURL, site_no = siteNumbers, range_selection = "date_range", - format = "rdb" - ) + format = "rdb") if (nzchar(startDate)) { - url <- appendDrURL(url, begin_date = startDate) + url <- httr2::req_url_query(url, begin_date = startDate) } if (nzchar(endDate)) { - url <- appendDrURL(url, end_date = endDate) + url <- httr2::req_url_query(url, end_date = endDate) } }, measurements = { - url <- appendDrURL(baseURL, + url <- httr2::req_url_query(baseURL, site_no = siteNumbers, range_selection = "date_range" ) if (nzchar(startDate)) { - url <- appendDrURL(url, + url <- httr2::req_url_query(url, begin_date = startDate ) } if (nzchar(endDate)) { - url <- appendDrURL(url, end_date = endDate) + url <- httr2::req_url_query(url, end_date = endDate) } if (expanded) { - url <- appendDrURL(url, format = "rdb_expanded") + url <- httr2::req_url_query(url, format = "rdb_expanded") } else { - url <- appendDrURL(url, format = "rdb") + url <- httr2::req_url_query(url, format = "rdb") } }, stat = { # for statistics service @@ -220,47 +225,42 @@ constructNWISURL <- function(siteNumbers, if (grepl("(?i)annual", statReportType) && (grepl("-", startDate) || grepl("-", endDate))) { stop("Start and end dates for annual statReportType can only include years") } - statType <- paste(statType, collapse = ",") - parameterCd <- paste(parameterCd, collapse = ",") - url <- appendDrURL(baseURL, + + url <- httr2::req_url_query(baseURL, sites = siteNumbers, - statType = statType, - statReportType = statReportType, - parameterCd = parameterCd - ) + statReportType = statReportType) + url <- httr2::req_url_query(url, statType = statType, + .multi = "comma") + url <- httr2::req_url_query(url, parameterCd = parameterCd, + .multi = "comma") + if (nzchar(startDate)) { - url <- appendDrURL(url, startDT = startDate) + url <- httr2::req_url_query(url, startDT = startDate) } if (nzchar(endDate)) { - url <- appendDrURL(url, endDT = endDate) + url <- httr2::req_url_query(url, endDT = endDate) } if (!grepl("(?i)daily", statReportType)) { - url <- appendDrURL(url, missingData = "off") + url <- httr2::req_url_query(url, missingData = "off") } }, gwlevels = { - url <- appendDrURL(baseURL, - site_no = siteNumbers, - format = "rdb" - ) + url <- httr2::req_url_query(baseURL, + site_no = siteNumbers,.multi = "comma") + url <- httr2::req_url_query(url,format = "rdb") if (nzchar(startDate)) { - url <- appendDrURL(url, begin_date = startDate) + url <- httr2::req_url_query(url, begin_date = startDate) } if (nzchar(endDate)) { - url <- appendDrURL(url, end_date = endDate) + url <- httr2::req_url_query(url, end_date = endDate) } - url <- paste(url, "group_key=NONE", - "date_format=YYYY-MM-DD", - "rdb_compression=value", - sep = "&") + url <- httr2::req_url_query(url, + group_key = "NONE", + date_format = "YYYY-MM-DD", + rdb_compression = "value") }, { # this will be either dv, uv, groundwater - multiplePcodes <- length(parameterCd) > 1 - # Check for 5 digit parameter code: - if (multiplePcodes) { - parameterCd <- paste(parameterCd, collapse = ",") - } format <- match.arg(format, c("xml", "tsv", "wml1", "wml2", "rdb")) @@ -272,36 +272,41 @@ constructNWISURL <- function(siteNumbers, wml1 = "waterml,1.1" ) - url <- appendDrURL(baseURL, - site = siteNumbers, - format = formatURL - ) + url <- httr2::req_url_query(baseURL, + site = siteNumbers, + .multi = "comma") + url <- httr2::req_url_query(url, + format = formatURL) - if (!is.na(parameterCd)) { - url <- appendDrURL(url, ParameterCd = parameterCd) + if (!all(is.na(parameterCd))) { + url <- httr2::req_url_query(url, + ParameterCd = parameterCd, + .multi = "comma") } if ("dv" == service) { - if (length(statCd) > 1) { - statCd <- paste(statCd, collapse = ",") - } - url <- appendDrURL(url, StatCd = statCd) + url <- httr2::req_url_query(url, + StatCd = statCd, + .multi = "comma") } if (nzchar(startDate)) { - url <- appendDrURL(url, startDT = startDate) + url <- httr2::req_url_query(url, startDT = startDate) } else { startorgin <- "1851-01-01" if ("iv" == service) startorgin <- "1900-01-01" - url <- appendDrURL(url, startDT = startorgin) + url <- httr2::req_url_query(url, startDT = startorgin) } if (nzchar(endDate)) { - url <- appendDrURL(url, endDT = endDate) + url <- httr2::req_url_query(url, endDT = endDate) } } ) + url <- httr2::req_headers(url, + `Accept-Encoding` = c("compress", "gzip", "deflate")) + return(url) } @@ -357,6 +362,7 @@ constructWQPURL <- function(siteNumbers, legacy = FALSE) { allPCode <- any(toupper(parameterCd) == "ALL") + if(!allPCode){ multiplePcodes <- length(parameterCd) > 1 @@ -364,51 +370,65 @@ constructWQPURL <- function(siteNumbers, suppressWarnings(pCodeLogic <- all(!is.na(as.numeric(parameterCd)))) } else { pCodeLogic <- FALSE - parameterCd <- sapply(parameterCd, utils::URLencode, USE.NAMES = FALSE, reserved = TRUE) - } - pcode_name <- ifelse(pCodeLogic, "pCode", "characteristicName") - } - - if(legacy & !allPCode){ - if (multiplePcodes) { - parameterCd <- paste(parameterCd, collapse = ";") } - parameterCd <- paste0(pcode_name, "=", parameterCd) - - } else if(!legacy & !allPCode){ - parameterCd <- paste0(pcode_name, "=", parameterCd) - if (multiplePcodes) { - parameterCd <- paste0(parameterCd, collapse = "&") - } } if(legacy){ + baseURL <- httr2::request(pkg.env[["Result"]]) siteNumbers <- paste(siteNumbers, collapse = ";") - baseURL <- drURL("Result", siteid = siteNumbers, Access = pkg.env$access) + baseURL <- httr2::req_url_query(baseURL, + siteids = siteNumbers) } else { - siteNumbers <- paste(paste0("siteid=", siteNumbers), collapse = "&") - baseURL <- drURL("ResultWQX3", Access = pkg.env$access) - baseURL <- paste0(baseURL, siteNumbers) + baseURL <- httr2::request(pkg.env[["ResultWQX3"]]) + baseURL <- httr2::req_url_query(baseURL, + siteids = siteNumbers, + .multi = "explode" ) } if(!allPCode){ - baseURL <- paste0(baseURL, "&", parameterCd) + if(legacy){ + if (multiplePcodes) { + parameterCd <- paste(parameterCd, collapse = ";") + if(pCodeLogic){ + baseURL <- httr2::req_url_query(baseURL, pCode = parameterCd) + } else { + baseURL <- httr2::req_url_query(baseURL, characteristicName = parameterCd) + } + } + } else { + if(pCodeLogic){ + baseURL <- httr2::req_url_query(baseURL, + pCode = parameterCd, + .multi = "explode") + } else { + baseURL <- httr2::req_url_query(baseURL, + characteristicName = parameterCd, + .multi = "explode") + } + } } if (nzchar(startDate)) { startDate <- format(as.Date(startDate), format = "%m-%d-%Y") - baseURL <- paste0(baseURL, "&startDateLo=", startDate) + baseURL <- httr2::req_url_query(baseURL, + startDateLo = startDate) } if (nzchar(endDate)) { endDate <- format(as.Date(endDate), format = "%m-%d-%Y") - baseURL <- paste0(baseURL, "&startDateHi=", endDate) + baseURL <- httr2::req_url_query(baseURL, + startDateHi = endDate) } - baseURL <- paste0(baseURL, "&mimeType=csv") + baseURL <- httr2::req_url_query(baseURL, mimeType = "csv") if(!legacy){ - baseURL <- paste0(baseURL, "&dataProfile=basicPhysChem") + baseURL <- httr2::req_url_query(baseURL, + dataProfile = "basicPhysChem") } + + baseURL <- httr2::req_headers(baseURL, + `Accept-Encoding` = c("compress", "gzip", "deflate")) + return(baseURL) } diff --git a/R/getWebServiceData.R b/R/getWebServiceData.R index 8aa6cd9a..d0eb7000 100644 --- a/R/getWebServiceData.R +++ b/R/getWebServiceData.R @@ -18,38 +18,49 @@ #' rawData <- getWebServiceData(obs_url) #' } getWebServiceData <- function(obs_url, ...) { + if (!has_internet_2(obs_url)){ message("No internet connection.") return(invisible(NULL)) } - - returnedList <- retryGetOrPost(obs_url, ...) + + obs_url <- httr2::req_user_agent(obs_url, default_ua()) + obs_url <- httr2::req_throttle(obs_url, rate = 30 / 60) + obs_url <- httr2::req_retry(obs_url, + backoff = ~ 5, max_tries = 3) + + returnedList <- httr2::req_perform(obs_url) good <- check_non_200s(returnedList) return_readLines <- c("text/html", "text/html; charset=UTF-8") + return_raw <- c("application/zip", "application/zip;charset=UTF-8", "application/vnd.geo+json;charset=UTF-8") + return_content <- c("text/tab-separated-values;charset=UTF-8", "text/csv;charset=UTF-8", - "text/plain") + "text/plain", + "text/plain;charset=UTF-8") if(good){ - headerInfo <- httr::headers(returnedList) + headerInfo <- httr2::resp_headers(returnedList) if (headerInfo$`content-type` %in% return_content) { - returnedDoc <- httr::content(returnedList, type = "text", encoding = "UTF-8") + returnedDoc <- httr2::resp_body_string(returnedList) trys <- 1 if (all(grepl("ERROR: INCOMPLETE DATA", returnedDoc))) { while(trys <= 3){ message("Trying again!") - obs_url <- paste0(obs_url, "&try=", trys) - returnedList <- retryGetOrPost(obs_url) + obs_url <- httr2::req_url_query(obs_url, + try = trys) + returnedList <- httr2::req_perform(obs_url) + good <- check_non_200s(returnedList) if(good){ - returnedDoc <- httr::content(returnedList, type = "text", encoding = "UTF-8") + returnedDoc <- httr2::resp_body_string(returnedList) } if (all(grepl("ERROR: INCOMPLETE DATA", returnedDoc))) { trys <- trys + 1 @@ -60,26 +71,17 @@ getWebServiceData <- function(obs_url, ...) { } } else if (headerInfo$`content-type` %in% return_raw) { - returnedDoc <- returnedList + returnedDoc <- httr2::resp_body_raw(returnedList) } else if (headerInfo$`content-type` %in% return_readLines) { + returnedList <- httr2::resp_body_string(returnedList) txt <- readLines(returnedList$content) message(txt) return(txt) } else { - returnedDoc <- httr::content(returnedList, encoding = "UTF-8") + returnedDoc <- httr2::resp_body_xml(returnedList, encoding = "UTF-8") if (all(grepl("No sites/data found using the selection criteria specified", returnedDoc))) { message(returnedDoc) } - if (headerInfo$`content-type` == "text/xml") { - if (xml2::xml_name(xml2::read_xml(returnedList)) == "ExceptionReport") { - statusReport <- tryCatch({ - xml2::xml_text(xml2::xml_child(xml2::read_xml(returnedList))) - }) - if (grepl("No feature found", statusReport)) { - message(statusReport) - } - } - } } attr(returnedDoc, "headerInfo") <- headerInfo @@ -92,35 +94,9 @@ getWebServiceData <- function(obs_url, ...) { check_non_200s <- function(returnedList){ - status <- httr::status_code(returnedList) - if (status == 400) { - if (httr::has_content(returnedList)) { - response400 <- httr::content(returnedList, type = "text", encoding = "UTF-8") - statusReport <- xml2::xml_text(xml2::xml_child(xml2::read_xml(response400), 2)) # making assumption that - body is second node - statusMsg <- gsub(pattern = ", server=.*", replacement = "", x = statusReport) - message(statusMsg) - } else { - httr::message_for_status(returnedList) - warning_message <- httr::headers(returnedList) - if ("warning" %in% names(warning_message)) { - warning_message <- warning_message$warning - message(warning_message) - } - } - return(FALSE) - } else if (status != 200) { - httr::message_for_status(returnedList) - return(FALSE) - - } else { - headerInfo <- httr::headers(returnedList) - - if (!"content-type" %in% names(headerInfo)) { - message("Unknown content, returning NULL") - return(FALSE) - } - return(TRUE) - } + status <- httr2::resp_status(returnedList) + + return(status == 200) } @@ -164,7 +140,13 @@ has_internet_2 <- function(obs_url) { } } - host <- gsub("^https://(?:www[.])?([^/]*).*$", "\\1", obs_url) + if("url" %in% names(obs_url)){ + url <- obs_url$url + } else { + url <- obs_url + } + + host <- gsub("^https://(?:www[.])?([^/]*).*$", "\\1", url) !is.null(curl::nslookup(host, error = FALSE)) } @@ -186,21 +168,4 @@ getQuerySummary <- function(url) { return(retquery) } -retryGetOrPost <- function(obs_url, ...) { - resp <- NULL - if (nchar(obs_url) < 2048 || grepl(pattern = "ngwmn", x = obs_url)) { - message("GET: ", obs_url) - resp <- httr::RETRY("GET", obs_url, ..., httr::user_agent(default_ua())) - } else { - split <- strsplit(obs_url, "?", fixed = TRUE) - obs_url <- split[[1]][1] - query <- split[[1]][2] - message("POST: ", obs_url) - resp <- httr::RETRY("POST", obs_url, ..., - body = query, - httr::content_type("application/x-www-form-urlencoded"), - httr::user_agent(default_ua()) - ) - } - return(resp) -} + diff --git a/R/importRDB1.R b/R/importRDB1.R index 5e5838e0..314bdc11 100644 --- a/R/importRDB1.R +++ b/R/importRDB1.R @@ -107,30 +107,27 @@ importRDB1 <- function(obs_url, tz <- match.arg(tz, OlsonNames()) - if (file.exists(obs_url)) { - f <- obs_url - } else { - f <- tempfile() - on.exit(unlink(f)) - - doc <- getWebServiceData(obs_url, - httr::write_disk(f), - encoding = "gzip" - ) - if (is.null(doc)) { + if(class(obs_url) == "httr2_request"){ + temp_file <- tempfile() + on.exit(unlink(temp_file)) + + doc <- getWebServiceData(obs_url) + write(doc, file = temp_file) + if (is.null(temp_file)) { return(invisible(NULL)) } - if ("warn" %in% names(attr(doc, "headerInfo"))) { - data <- data.frame() - attr(data, "headerInfo") <- attr(doc, "headerInfo") - attr(data, "url") <- obs_url - attr(data, "queryTime") <- Sys.time() - - return(data) + + } else { + if (file.exists(obs_url)){ + temp_file <- obs_url + } else { + warning("Unknown Input") + return(NULL) } - } + + } - readr.total <- readLines(f) + readr.total <- readLines(temp_file) total.rows <- length(readr.total) readr.meta <- readr.total[grep("^#", readr.total)] @@ -150,7 +147,7 @@ importRDB1 <- function(obs_url, if (data.rows > 0) { args_list <- list( - file = f, + file = temp_file, delim = "\t", quote = "", skip = meta.rows + 2, @@ -307,8 +304,8 @@ importRDB1 <- function(obs_url, } attr(readr.data, "queryTime") <- Sys.time() - if (!file.exists(obs_url)) { - attr(readr.data, "url") <- obs_url + if (class(obs_url) == "httr2_request") { + attr(readr.data, "url") <- obs_url$url attr(readr.data, "headerInfo") <- attr(doc, "headerInfo") } diff --git a/R/importWaterML1.R b/R/importWaterML1.R index 08ce5f00..64660811 100644 --- a/R/importWaterML1.R +++ b/R/importWaterML1.R @@ -110,6 +110,7 @@ importWaterML1 <- function(obs_url, asDateTime = FALSE, tz = "UTC") { if (tz == "") { # check tz is valid if supplied tz <- "UTC" } + tz <- match.arg(tz, OlsonNames()) timeSeries <- xml2::xml_find_all(returnedDoc, ".//ns1:timeSeries") # each parameter/site combo diff --git a/R/readNWISdv.R b/R/readNWISdv.R index a4415735..95fb5e76 100644 --- a/R/readNWISdv.R +++ b/R/readNWISdv.R @@ -82,6 +82,7 @@ readNWISdv <- function(siteNumbers, startDate = "", endDate = "", statCd = "00003") { + url <- constructNWISURL( siteNumbers = siteNumbers, parameterCd = parameterCd, diff --git a/R/readNWISsite.R b/R/readNWISsite.R index dfd1f954..77ceab9e 100644 --- a/R/readNWISsite.R +++ b/R/readNWISsite.R @@ -66,13 +66,15 @@ #' siteINFOMulti <- readNWISsite(c("05114000", "09423350")) #' } readNWISsite <- function(siteNumbers) { - siteNumber <- paste(siteNumbers, collapse = ",") - names(siteNumber) <- "site" - urlSitefile <- drURL("site", - Access = pkg.env$access, - siteOutput = "Expanded", format = "rdb" - ) - urlSitefile <- appendDrURL(urlSitefile, arg.list = siteNumber) + + baseURL <- httr2::request(pkg.env[["site"]]) + urlSitefile <- httr2::req_url_query(baseURL, + siteOutput = "Expanded", + format = "rdb") + + urlSitefile <- httr2::req_url_query(urlSitefile, + site = siteNumber, + .multi = "comma") data <- importRDB1(urlSitefile, asDateTime = FALSE) # readr needs multiple lines to convert to anything but characters: diff --git a/man/constructNWISURL.Rd b/man/constructNWISURL.Rd index 6888b3ce..0fa25f29 100644 --- a/man/constructNWISURL.Rd +++ b/man/constructNWISURL.Rd @@ -70,12 +70,7 @@ full list of codes.} url string } \description{ -Imports data from NWIS web service. This function gets the data from here: -\url{https://nwis.waterdata.usgs.gov/nwis/qwdata} -A list of parameter codes can be found here: -\url{https://nwis.waterdata.usgs.gov/nwis/pmcodes/} -A list of statistic codes can be found here: -\url{https://nwis.waterdata.usgs.gov/nwis/help/?read_file=stat&format=table} +Using USGS water web services to construct urls. } \examples{ site_id <- "01594440" From 84cb3cc5987dfd4b52942d8535ded7bc73c48d0a Mon Sep 17 00:00:00 2001 From: Laura A DeCicco Date: Thu, 24 Oct 2024 11:47:55 -0500 Subject: [PATCH 02/30] Getting there! --- R/constructNWISURL.R | 4 +++- R/getWebServiceData.R | 4 +++- R/readNWISpCode.R | 7 ++++--- 3 files changed, 10 insertions(+), 5 deletions(-) diff --git a/R/constructNWISURL.R b/R/constructNWISURL.R index cbfaabf0..3eb47ebd 100644 --- a/R/constructNWISURL.R +++ b/R/constructNWISURL.R @@ -175,9 +175,11 @@ constructNWISURL <- function(siteNumbers, }, peak = { url <- httr2::req_url_query(baseURL, - site_no = siteNumbers, range_selection = "date_range", format = "rdb") + url <- httr2::req_url_query(url, + site_no = siteNumbers, + .multi = "comma") if (nzchar(startDate)) { url <- httr2::req_url_query(url, begin_date = startDate) } diff --git a/R/getWebServiceData.R b/R/getWebServiceData.R index d0eb7000..cd8653a4 100644 --- a/R/getWebServiceData.R +++ b/R/getWebServiceData.R @@ -29,6 +29,7 @@ getWebServiceData <- function(obs_url, ...) { obs_url <- httr2::req_retry(obs_url, backoff = ~ 5, max_tries = 3) + print(obs_url) returnedList <- httr2::req_perform(obs_url) good <- check_non_200s(returnedList) @@ -42,7 +43,8 @@ getWebServiceData <- function(obs_url, ...) { return_content <- c("text/tab-separated-values;charset=UTF-8", "text/csv;charset=UTF-8", "text/plain", - "text/plain;charset=UTF-8") + "text/plain;charset=UTF-8", + "text/plain; charset=UTF-8") if(good){ headerInfo <- httr2::resp_headers(returnedList) diff --git a/R/readNWISpCode.R b/R/readNWISpCode.R index 5da3f714..34cb0a57 100644 --- a/R/readNWISpCode.R +++ b/R/readNWISpCode.R @@ -33,9 +33,10 @@ readNWISpCode <- function(parameterCd) { parameterCd.orig <- parameterCd parameterCd <- parameterCd[!is.na(parameterCd)] - - baseURL <- drURL("pCode", Access = pkg.env$access) - fullURL <- paste0(baseURL, "fmt=rdb&group_cd=%") + baseURL <- httr2::request(pkg.env[["pCode"]]) + fullURL <- httr2::req_url_query(baseURL, + fmt = "rdb", + group_cd ="%") if (any(parameterCd == "all")) { temp_df <- importRDB1(fullURL, asDateTime = FALSE) From a8f236e10320b17f60eb59e7e02ba05c7674f659 Mon Sep 17 00:00:00 2001 From: Laura A DeCicco Date: Thu, 24 Oct 2024 16:18:01 -0500 Subject: [PATCH 03/30] update ua --- R/getWebServiceData.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/getWebServiceData.R b/R/getWebServiceData.R index cd8653a4..5fd68de0 100644 --- a/R/getWebServiceData.R +++ b/R/getWebServiceData.R @@ -109,7 +109,7 @@ check_non_200s <- function(returnedList){ default_ua <- function() { versions <- c( libcurl = curl::curl_version()$version, - httr = as.character(utils::packageVersion("httr")), + httr2 = as.character(utils::packageVersion("httr2")), dataRetrieval = as.character(utils::packageVersion("dataRetrieval")) ) From ea8170ab0d787b14170864b3285db1bf61bfc023 Mon Sep 17 00:00:00 2001 From: Laura A DeCicco Date: Thu, 24 Oct 2024 16:28:38 -0500 Subject: [PATCH 04/30] start --- R/importWQP.R | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/R/importWQP.R b/R/importWQP.R index 2a0748c3..eecd82db 100644 --- a/R/importWQP.R +++ b/R/importWQP.R @@ -45,12 +45,8 @@ importWQP <- function(obs_url, tz = "UTC", tz <- "UTC" } - if (!file.exists(obs_url)) { - - doc <- getWebServiceData( - obs_url, - httr::accept("text/csv") - ) + if (class(obs_url) == "httr2_request") { + doc <- getWebServiceData(obs_url) if (is.null(doc)) { return(invisible(NULL)) } From 6062607cecfa9b4f7d3805572ae996722f046ae6 Mon Sep 17 00:00:00 2001 From: Laura A DeCicco Date: Fri, 1 Nov 2024 14:56:16 -0500 Subject: [PATCH 05/30] cleaning up WQP calls --- R/constructNWISURL.R | 56 ++++++++++++++++++++++++++------------------ 1 file changed, 33 insertions(+), 23 deletions(-) diff --git a/R/constructNWISURL.R b/R/constructNWISURL.R index f4464806..afec9836 100644 --- a/R/constructNWISURL.R +++ b/R/constructNWISURL.R @@ -300,7 +300,6 @@ constructWQPURL <- function(siteNumbers, if(!allPCode){ multiplePcodes <- length(parameterCd) > 1 - if (all(nchar(parameterCd) == 5)) { suppressWarnings(pCodeLogic <- all(!is.na(as.numeric(parameterCd)))) } else { @@ -312,35 +311,46 @@ constructWQPURL <- function(siteNumbers, baseURL <- httr2::request(pkg.env[["Result"]]) siteNumbers <- paste(siteNumbers, collapse = ";") baseURL <- httr2::req_url_query(baseURL, - siteids = siteNumbers) + siteid = siteNumbers) } else { baseURL <- httr2::request(pkg.env[["ResultWQX3"]]) baseURL <- httr2::req_url_query(baseURL, - siteids = siteNumbers, + siteid = siteNumbers, .multi = "explode" ) } - + if(!allPCode){ - if(legacy){ - if (multiplePcodes) { - parameterCd <- paste(parameterCd, collapse = ";") - if(pCodeLogic){ - baseURL <- httr2::req_url_query(baseURL, pCode = parameterCd) - } else { - baseURL <- httr2::req_url_query(baseURL, characteristicName = parameterCd) - } - } + multiplePcodes <- length(parameterCd) > 1 + + if (all(nchar(parameterCd) == 5)) { + suppressWarnings(pCodeLogic <- all(!is.na(as.numeric(parameterCd)))) } else { - if(pCodeLogic){ - baseURL <- httr2::req_url_query(baseURL, - pCode = parameterCd, - .multi = "explode") - } else { - baseURL <- httr2::req_url_query(baseURL, - characteristicName = parameterCd, - .multi = "explode") - } - } + pCodeLogic <- FALSE + } + } + + if(legacy & !allPCode){ + if (multiplePcodes) { + parameterCd <- paste(parameterCd, collapse = ";") + } + if(pCodeLogic){ + baseURL <- httr2::req_url_query(baseURL, pCode = parameterCd) + } else { + baseURL <- httr2::req_url_query(baseURL, characteristicName = parameterCd) + } + + + } else if(!legacy & !allPCode){ + parameterCd <- paste0(pcode_name, "=", parameterCd) + + if(pcode_name){ + baseURL <- httr2::req_url_query(baseURL, pCode = parameterCd, + .multi = "explode") + } else { + baseURL <- httr2::req_url_query(baseURL, + characteristicName = parameterCd, + .multi = "explode") + } } if (nzchar(startDate)) { From af0b523f96d043437293cb01a1bda5ea2cf6748a Mon Sep 17 00:00:00 2001 From: Laura A DeCicco Date: Fri, 1 Nov 2024 15:07:16 -0500 Subject: [PATCH 06/30] style --- R/getWebServiceData.R | 7 +++---- R/importWQP.R | 5 +++-- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/R/getWebServiceData.R b/R/getWebServiceData.R index 5fd68de0..25c2e92a 100644 --- a/R/getWebServiceData.R +++ b/R/getWebServiceData.R @@ -1,8 +1,7 @@ #' Function to return data from web services #' -#' This function accepts a url parameter, and returns the raw data. The function enhances -#' \code{\link[httr]{GET}} with more informative error messages. -#' +#' This function accepts a url parameter, and returns the raw data. +#' #' @param obs_url character containing the url for the retrieval #' @param \dots information to pass to header request #' @export @@ -29,7 +28,7 @@ getWebServiceData <- function(obs_url, ...) { obs_url <- httr2::req_retry(obs_url, backoff = ~ 5, max_tries = 3) - print(obs_url) + print(obs_url) #when happy with httr2, maybe only print url returnedList <- httr2::req_perform(obs_url) good <- check_non_200s(returnedList) diff --git a/R/importWQP.R b/R/importWQP.R index 2086c543..2f9282c6 100644 --- a/R/importWQP.R +++ b/R/importWQP.R @@ -74,8 +74,9 @@ importWQP <- function(obs_url, tz = "UTC", if(convertType){ retval <- parse_WQP(retval, tz) } - attr(retval, "headerInfo") <- headerInfo - + if (class(obs_url) == "httr2_request") { + attr(retval, "headerInfo") <- headerInfo + } return(retval) } From f1bbab0361515d492acbd87d13a8d66c2e6ca2c1 Mon Sep 17 00:00:00 2001 From: Laura A DeCicco Date: Sat, 2 Nov 2024 16:15:02 -0500 Subject: [PATCH 07/30] getting the lists correct --- R/readNWISdata.R | 43 ++++++++++++++++++++----------------------- 1 file changed, 20 insertions(+), 23 deletions(-) diff --git a/R/readNWISdata.R b/R/readNWISdata.R index 48f579ab..4a2727a5 100644 --- a/R/readNWISdata.R +++ b/R/readNWISdata.R @@ -202,6 +202,10 @@ readNWISdata <- function(..., asDateTime = TRUE, convertType = TRUE, tz = "UTC") valuesList <- readNWISdots(...) + values <- valuesList[["values"]] + values <- values[names(values) != "format"] + format <- valuesList[["values"]][["format"]] + service <- valuesList$service if (length(service) > 1) { warning("Only one service value is allowed. Service: ", service[1], " will be used.") @@ -219,18 +223,14 @@ https://cran.r-project.org/web/packages/dataRetrieval/vignettes/qwdata_changes.h ) } - values <- sapply(valuesList$values, function(x)utils:: URLencode(x)) - - baseURL <- drURL(service, arg.list = values) - - if (service %in% c("site", "dv", "iv")) { - baseURL <- appendDrURL(baseURL, Access = pkg.env$access) + baseURL <- httr2::request(pkg.env[[service]]) + if (service != "rating") { + baseURL <- httr2::req_url_query(baseURL, format = format) } - # actually get the data - if (length(grep("rdb", values["format"])) > 0) { - if (service == "rating") { - baseURL <- gsub(pattern = "&format=rdb", replacement = "", baseURL) - } + + baseURL <- httr2::req_url_query(baseURL, !!!values, .multi = "comma") + + if (length(grep("rdb", format)) > 0) { retval <- importRDB1(baseURL, tz = tz, asDateTime = asDateTime, convertType = convertType) } else { retval <- importWaterML1(baseURL, tz = tz, asDateTime = asDateTime) @@ -256,7 +256,7 @@ https://cran.r-project.org/web/packages/dataRetrieval/vignettes/qwdata_changes.h ) ) # TODO: Think about dates that cross a time zone boundary. - if (values["format"] == "waterml,1.1" && nrow(retval) > 0) { + if (format == "waterml,1.1" && nrow(retval) > 0) { retval$dateTime <- as.POSIXct(retval$dateTime, tzLib[tz = retval$tz_cd[1]]) } } @@ -413,21 +413,19 @@ readNWISdots <- function(...) { match.arg(service, c( "dv", "iv", "iv_recent", "gwlevels", - "site", "uv", "qw", "measurements", + "site", "uv", "measurements", "qwdata", "stat", "rating", "peak" )) if (service == "uv") { service <- "iv" - } else if (service == "qw") { - service <- "qwdata" - } + } if (length(service) > 1) { stop("Only one service call allowed.") } - values <- sapply(matchReturn, function(x) as.character(paste0(eval(x), collapse = ","))) + values <- matchReturn names(values)[names(values) == "startDate"] <- "startDT" names(values)[names(values) == "endDate"] <- "endDT" @@ -477,7 +475,7 @@ readNWISdots <- function(...) { } } - if (service %in% c("peak", "qwdata", "measurements", "gwlevels")) { + if (service %in% c("peak", "measurements", "gwlevels")) { format.default <- "rdb" names(values)[names(values) == "startDT"] <- "begin_date" @@ -501,9 +499,6 @@ readNWISdots <- function(...) { values["range_selection"] <- "date_range" } - if (service == "qwdata" && !("qw_sample_wide" %in% names(values))) { - values["qw_sample_wide"] <- "wide" - } } if (service %in% c("peak", "gwlevels") && "stateCd" %in% names(values)) { @@ -535,8 +530,10 @@ readNWISdots <- function(...) { if (!("format" %in% names(values))) { values["format"] <- format.default } - - return(list(values = values, service = service)) + return_list <- list() + return_list["values"] <- list(values) + return_list["service"] <- service + return(return_list) } #' convert variables in dots to usable format From 993a2a45b9e30993efc13352f16af48db848e9a6 Mon Sep 17 00:00:00 2001 From: Laura A DeCicco Date: Sun, 3 Nov 2024 10:42:52 -0600 Subject: [PATCH 08/30] More NWIS and WQP httr2 updates --- DESCRIPTION | 1 - NEWS | 4 ++ R/getWebServiceData.R | 19 +++++--- R/importWaterML1.R | 7 --- R/readWQPdata.R | 39 +++++++++++---- R/readWQPdots.R | 38 +++++---------- R/whatNWISdata.R | 13 +++-- R/whatNWISsites.R | 13 +++-- R/whatWQPdata.R | 101 +++++++++++++++++++++++++-------------- R/whatWQPsites.R | 60 +++++++++++++---------- man/getWebServiceData.Rd | 3 +- man/readWQPdata.Rd | 11 +++++ man/whatWQPdata.Rd | 4 +- 13 files changed, 191 insertions(+), 122 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 3086ab62..6362d9ea 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -39,7 +39,6 @@ Copyright: This software is in the public domain because it contains materials Depends: R (>= 3.5.0) Imports: - httr (>= 1.0.0), curl, lubridate (>= 1.5.0), stats, diff --git a/NEWS b/NEWS index 2706f45b..5d85414c 100644 --- a/NEWS +++ b/NEWS @@ -1,3 +1,7 @@ +dataRetrieval 2.7.18 +=================== +* Switched from httr to httr2 + dataRetrieval 2.7.17 =================== * Fixed bug with server problems causing errors. diff --git a/R/getWebServiceData.R b/R/getWebServiceData.R index 25c2e92a..14c5e1dd 100644 --- a/R/getWebServiceData.R +++ b/R/getWebServiceData.R @@ -36,8 +36,7 @@ getWebServiceData <- function(obs_url, ...) { return_readLines <- c("text/html", "text/html; charset=UTF-8") return_raw <- c("application/zip", - "application/zip;charset=UTF-8", - "application/vnd.geo+json;charset=UTF-8") + "application/zip;charset=UTF-8") return_content <- c("text/tab-separated-values;charset=UTF-8", "text/csv;charset=UTF-8", @@ -45,6 +44,8 @@ getWebServiceData <- function(obs_url, ...) { "text/plain;charset=UTF-8", "text/plain; charset=UTF-8") + return_json <- c("application/vnd.geo+json;charset=UTF-8") + if(good){ headerInfo <- httr2::resp_headers(returnedList) @@ -78,6 +79,8 @@ getWebServiceData <- function(obs_url, ...) { txt <- readLines(returnedList$content) message(txt) return(txt) + } else if (headerInfo$`content-type` %in% return_json){ + returnedDoc <- httr2::resp_body_json(returnedList) } else { returnedDoc <- httr2::resp_body_xml(returnedList, encoding = "UTF-8") if (all(grepl("No sites/data found using the selection criteria specified", returnedDoc))) { @@ -157,10 +160,14 @@ has_internet_2 <- function(obs_url) { #' @param url the query url getQuerySummary <- function(url) { wqp_message() - queryHEAD <- httr::HEAD(url) - retquery <- httr::headers(queryHEAD) - - retquery[grep("-count", names(retquery))] <- as.numeric(retquery[grep("-count", names(retquery))]) + + queryHEAD <- httr2::req_method(req = url , + method = "HEAD") + queryHEAD <- httr2::req_perform(queryHEAD) + headerInfo <- httr2::resp_headers(queryHEAD) + retquery <- data.frame(t(unlist(headerInfo))) + names(retquery) <- gsub("\\.", "-", names(retquery)) + retquery[,grep("-count", names(retquery))] <- as.numeric(retquery[grep("-count", names(retquery))]) if ("date" %in% names(retquery)) { retquery$date <- as.Date(retquery$date, format = "%a, %d %b %Y %H:%M:%S") diff --git a/R/importWaterML1.R b/R/importWaterML1.R index 64660811..0f19b242 100644 --- a/R/importWaterML1.R +++ b/R/importWaterML1.R @@ -88,13 +88,6 @@ #' asDateTime = TRUE, tz = "America/Chicago" #' ) #' -#' # raw XML -#' url <- constructNWISURL( -#' service = "dv", siteNumber = "02319300", parameterCd = "00060", -#' startDate = "2014-01-01", endDate = "2014-01-01" -#' ) -#' raw <- httr::content(httr::GET(url), as = "raw") -#' rawParsed <- importWaterML1(raw) #' } #' filePath <- system.file("extdata", package = "dataRetrieval") #' fileName <- "WaterML1Example.xml" diff --git a/R/readWQPdata.R b/R/readWQPdata.R index a236f7a5..ec4ee45e 100644 --- a/R/readWQPdata.R +++ b/R/readWQPdata.R @@ -193,6 +193,17 @@ #' ignore_attributes = TRUE, #' convertType = FALSE #' ) +#' +#' rawPHsites_legacy <- readWQPdata(siteid = c("USGS-05406450", "USGS-05427949", "WIDNR_WQX-133040"), +#' characteristicName = "pH", +#' service = "Result", +#' dataProfile = "narrowResult" ) +#' +#' rawPHsites <- readWQPdata(siteid = c("USGS-05406450", "USGS-05427949", "WIDNR_WQX-133040"), +#' characteristicName = "pH", +#' service = "ResultWQX3", +#' dataProfile = "narrow" ) +#' #' } readWQPdata <- function(..., service = "Result", @@ -214,18 +225,30 @@ readWQPdata <- function(..., legacy <- is_legacy(service) valuesList <- readWQPdots(..., legacy = legacy) - - values <- sapply(valuesList$values, function(x) utils::URLencode(x, reserved = TRUE)) - - baseURL <- drURL(service, arg.list = values) - - baseURL <- appendDrURL(baseURL, mimeType = "csv") + values <- valuesList[["values"]] + baseURL <- httr2::request(pkg.env[[service]]) + if(!legacy){ if(service == "ResultWQX3" & !"dataProfile" %in% names(values)){ - baseURL <- appendDrURL(baseURL, dataProfile = "fullPhysChem") + baseURL <- httr2::req_url_query(baseURL, + dataProfile = "fullPhysChem") } - } + baseURL <- httr2::req_url_query(baseURL, !!!values, + .multi = "explode") + } else { + if("siteid" %in% names(values)){ + if(length(values[["siteid"]]) > 1){ + sites <- values[["siteid"]] + sites <- paste0(sites, collapse = ";") + baseURL <- httr2::req_url_query(baseURL, + siteid = sites) + values <- values[names(values) != "siteid"] + } + } + baseURL <- httr2::req_url_query(baseURL, !!!values, + .multi = "explode") + } if (querySummary) { retquery <- getQuerySummary(baseURL) diff --git a/R/readWQPdots.R b/R/readWQPdots.R index 31ec6d78..253cd609 100644 --- a/R/readWQPdots.R +++ b/R/readWQPdots.R @@ -48,31 +48,10 @@ readWQPdots <- function(..., legacy = TRUE) { bbox <- "bBox" %in% names(matchReturn) if(bbox){ - values_bbox <- sapply(matchReturn["bBox"], function(x) as.character(paste0(eval(x), collapse = ","))) - matchReturn <- matchReturn[names(matchReturn) != "bBox"] + matchReturn["bBox"] <- sapply(matchReturn["bBox"], function(x) as.character(paste0(eval(x), collapse = ","))) } - - if(!legacy){ - new_list <- rep(list(NA),length(unlist(matchReturn))) - names_list <- c() - i <- 1 - for(arg in names(matchReturn)){ - for(val in as.character(matchReturn[[arg]])) { - new_list[[i]] <- val - names_list <- c(names_list, arg) - i <- i + 1 - } - } - names(new_list) <- names_list - matchReturn <- new_list - } - - values <- sapply(matchReturn, function(x) as.character(paste0(eval(x), collapse = ";"))) - - if (bbox) { - values <- c(values, values_bbox) - } - + + values <- matchReturn values <- checkWQPdates(values) names(values)[names(values) == "siteNumber"] <- "siteid" @@ -102,7 +81,14 @@ readWQPdots <- function(..., legacy = TRUE) { sep = ":" ) } - - return(list(values = values, service = service)) + + if(!"mimeType" %in% names(values)){ + values["mimeType"] <- "csv" + } + + return_list <- list() + return_list["values"] <- list(values) + return_list["service"] <- service + return(return_list) } diff --git a/R/whatNWISdata.R b/R/whatNWISdata.R index 2ed4065c..dc9867c8 100644 --- a/R/whatNWISdata.R +++ b/R/whatNWISdata.R @@ -140,10 +140,15 @@ whatNWISdata <- function(..., convertType = TRUE) { valuesList <- readNWISdots(matchReturn) - values <- sapply(valuesList$values, function(x) utils::URLencode(x)) - - urlSitefile <- drURL("site", Access = pkg.env$access, seriesCatalogOutput = "true", arg.list = values) - + values <- valuesList[["values"]] + values <- values[names(values) != "format"] + + urlSitefile <- httr2::request(pkg.env[["site"]]) + urlSitefile <- httr2::req_url_query(urlSitefile, + seriesCatalogOutput = "true") + urlSitefile <- httr2::req_url_query(urlSitefile, !!!values, + .multi = "comma") + SiteFile <- importRDB1(urlSitefile, asDateTime = FALSE, convertType = convertType) if (!("all" %in% service)) { diff --git a/R/whatNWISsites.R b/R/whatNWISsites.R index 2c61f463..6626e337 100644 --- a/R/whatNWISsites.R +++ b/R/whatNWISsites.R @@ -38,9 +38,11 @@ whatNWISsites <- function(...) { matchReturn <- convertLists(...) valuesList <- readNWISdots(...) - values <- sapply(valuesList$values, function(x) utils::URLencode(x)) - values["format"] <- "mapper" + values <- valuesList[["values"]] + values <- values[names(values) != "format"] + values <- sapply(valuesList$values, function(x) utils::URLencode(x)) + ################# # temporary gwlevels fixes values <- values[!names(values) %in% c("date_format", @@ -60,8 +62,11 @@ whatNWISsites <- function(...) { "peak" = "pk") } - urlCall <- drURL("site", Access = pkg.env$access, arg.list = values) - + urlCall <- httr2::request(pkg.env[["site"]]) + urlCall <- httr2::req_url_query(urlCall, !!!values, + .multi = "comma") + urlCall <- httr2::req_url_query(urlCall, format = "mapper") + rawData <- getWebServiceData(urlCall, encoding = "gzip") if (is.null(rawData)) { return(invisible(NULL)) diff --git a/R/whatWQPdata.R b/R/whatWQPdata.R index 5e83665c..749104df 100644 --- a/R/whatWQPdata.R +++ b/R/whatWQPdata.R @@ -21,7 +21,7 @@ whatWQPsamples <- function(..., legacy = TRUE) { values <- readWQPdots(..., legacy = legacy) - values <- values$values + values <- values[["values"]] if ("tz" %in% names(values)) { values <- values[!(names(values) %in% "tz")] @@ -31,16 +31,29 @@ whatWQPsamples <- function(..., values <- values[!(names(values) %in% "service")] } - values <- sapply(values, function(x) utils::URLencode(x, reserved = TRUE)) - if(legacy){ - baseURL <- drURL("Activity", arg.list = values) + baseURL <- httr2::request(pkg.env[["Activity"]]) } else { - baseURL <- drURL("ActivityWQX3", arg.list = values) + baseURL <- httr2::request(pkg.env[["ActivityWQX3"]]) } - - baseURL <- appendDrURL(baseURL, mimeType = "csv") + if(!legacy){ + baseURL <- httr2::req_url_query(baseURL, !!!values, + .multi = "explode") + } else { + if("siteid" %in% names(values)){ + if(length(values[["siteid"]]) > 1){ + sites <- values[["siteid"]] + sites <- paste0(sites, collapse = ";") + baseURL <- httr2::req_url_query(baseURL, + siteid = sites) + values <- values[names(values) != "siteid"] + } + } + baseURL <- httr2::req_url_query(baseURL, !!!values, + .multi = "explode") + } + retval <- importWQP(baseURL, convertType = convertType) if(!is.null(retval)){ @@ -79,7 +92,7 @@ whatWQPmetrics <- function(..., convertType = TRUE) { values <- readWQPdots(..., legacy = TRUE) - values <- values$values + values <- values[["values"]] if ("tz" %in% names(values)) { values <- values[!(names(values) %in% "tz")] @@ -89,11 +102,19 @@ whatWQPmetrics <- function(..., values <- values[!(names(values) %in% "service")] } - values <- sapply(values, function(x) utils::URLencode(x, reserved = TRUE)) - - baseURL <- drURL("ActivityMetric", arg.list = values) - - baseURL <- appendDrURL(baseURL, mimeType = "csv") + baseURL <- httr2::request(pkg.env[["ActivityMetric"]]) + + if("siteid" %in% names(values)){ + if(length(values[["siteid"]]) > 1){ + sites <- values[["siteid"]] + sites <- paste0(sites, collapse = ";") + baseURL <- httr2::req_url_query(baseURL, + siteid = sites) + values <- values[names(values) != "siteid"] + } + } + baseURL <- httr2::req_url_query(baseURL, !!!values, + .multi = "explode") withCallingHandlers( { @@ -146,7 +167,6 @@ whatWQPmetrics <- function(..., #' in the Query URL. The corresponding argument for dataRetrieval is #' characteristicType = "Nutrient". dataRetrieval users do not need to include #' mimeType, and providers is optional (these arguments are picked automatically). -#' @param saveFile path to save the incoming geojson output. #' @param convertType logical, defaults to \code{TRUE}. If \code{TRUE}, the function #' will convert the data to dates, datetimes, #' numerics based on a standard algorithm. If false, everything is returned as a character. @@ -172,30 +192,39 @@ whatWQPmetrics <- function(..., #' bbox <- c(-86.9736, 34.4883, -86.6135, 34.6562) #' what_bb <- whatWQPdata(bBox = bbox) #' -whatWQPdata <- function(..., saveFile = tempfile(), +whatWQPdata <- function(..., convertType = TRUE) { values <- readWQPdots(..., legacy = TRUE) - values <- values$values + values <- values[["values"]] - if ("tz" %in% names(values)) { - values <- values[!(names(values) %in% "tz")] + if (any(c("tz", "service", "mimeType") %in% names(values))){ + values <- values[!(names(values) %in% c("tz", "service", "mimeType"))] } - if ("service" %in% names(values)) { - values <- values[!(names(values) %in% "service")] + if("siteid" %in% names(values)){ + if(length(values[["siteid"]]) > 1){ + sites <- values[["siteid"]] + sites <- paste0(sites, collapse = ";") + baseURL <- httr2::req_url_query(baseURL, + siteid = sites) + values <- values[names(values) != "siteid"] + } } + + baseURL <- httr2::request(pkg.env[["Station"]]) + + baseURL <- httr2::req_url_query(baseURL, + !!!values, + .multi = "explode") - values <- sapply(values, function(x) utils::URLencode(x, reserved = TRUE)) - - baseURL <- drURL("Station", arg.list = values) - - baseURL <- appendDrURL(baseURL, mimeType = "geojson") + baseURL <- httr2::req_url_query(baseURL, + mimeType = "geojson") - # Not sure if there's a geojson option with WQX + # Not sure if there's a geojson option with WQX3 wqp_message() - doc <- getWebServiceData(baseURL, httr::write_disk(saveFile)) + doc <- getWebServiceData(baseURL) if (is.null(doc)) { return(invisible(NULL)) @@ -227,13 +256,16 @@ whatWQPdata <- function(..., saveFile = tempfile(), y <- data.frame(lapply(y, as.character), stringsAsFactors = FALSE) } } else { - - retval <- as.data.frame(jsonlite::fromJSON(saveFile), stringsAsFactors = FALSE) - df_cols <- as.integer(which(sapply(retval, class) == "data.frame")) - y <- retval[, -df_cols] - - for (i in df_cols) { - y <- cbind(y, retval[[i]]) + + features <- doc[["features"]] + y <- data.frame(matrix(NA, nrow = length(features), ncol = 15)) + names(y) <- c(names(features[[1]][["properties"]]), + "lat", "lon") + for(i in seq_along(features)){ + single_feature <- features[[i]][["properties"]] + single_feature[["lat"]] <- unlist(features[[i]][["geometry"]][["coordinates"]][2]) + single_feature[["lon"]] <- unlist(features[[i]][["geometry"]][["coordinates"]][1]) + y[i,] <- single_feature } if (convertType) { @@ -265,6 +297,5 @@ whatWQPdata <- function(..., saveFile = tempfile(), attr(y, "queryTime") <- Sys.time() attr(y, "url") <- baseURL - attr(y, "file") <- saveFile return(y) } diff --git a/R/whatWQPsites.R b/R/whatWQPsites.R index 5eff8fe8..0e91f53a 100644 --- a/R/whatWQPsites.R +++ b/R/whatWQPsites.R @@ -47,26 +47,30 @@ whatWQPsites <- function(..., legacy = TRUE) { values <- readWQPdots(..., legacy = legacy) - values <- values$values + values <- values[["values"]] - if ("tz" %in% names(values)) { - values <- values[!(names(values) %in% "tz")] + if (any(c("tz", "service") %in% names(values))){ + values <- values[!(names(values) %in% c("tz", "service"))] } - if ("service" %in% names(values)) { - values <- values[!(names(values) %in% "service")] - } - - values <- sapply(values, function(x) utils::URLencode(x, reserved = TRUE)) - if(legacy){ - baseURL <- drURL("Station", arg.list = values) + baseURL <- httr2::request(pkg.env[["Station"]]) + if("siteid" %in% names(values)){ + if(length(values[["siteid"]]) > 1){ + sites <- values[["siteid"]] + sites <- paste0(sites, collapse = ";") + baseURL <- httr2::req_url_query(baseURL, + siteid = sites) + values <- values[names(values) != "siteid"] + } + } } else { - baseURL <- drURL("StationWQX3", arg.list = values) + baseURL <- httr2::request(pkg.env[["StationWQX3"]]) } + baseURL <- httr2::req_url_query(baseURL, + !!!values, + .multi = "explode") - baseURL <- appendDrURL(baseURL, mimeType = "csv") - retval <- importWQP(baseURL) if(!is.null(retval)){ @@ -142,26 +146,30 @@ readWQPsummary <- function(...) { values <- readWQPdots(...) - values <- values$values - - if ("tz" %in% names(values)) { - values <- values[!(names(values) %in% "tz")] - } + values <- values[["values"]] - if ("service" %in% names(values)) { - values <- values[!(names(values) %in% "service")] + if (any(c("tz", "service") %in% names(values))){ + values <- values[!(names(values) %in% c("tz", "service"))] } if (!"dataProfile" %in% names(values)) { values[["dataProfile"]] <- "periodOfRecord" } + + baseURL <- httr2::request(pkg.env[["SiteSummary"]]) - values <- sapply(values, function(x) utils::URLencode(x, reserved = TRUE)) - - baseURL <- drURL("SiteSummary", arg.list = values) - - baseURL <- appendDrURL(baseURL, mimeType = "csv") - + if(length(values[["siteid"]]) > 1){ + sites <- values[["siteid"]] + sites <- paste0(sites, collapse = ";") + baseURL <- httr2::req_url_query(baseURL, + siteid = sites) + values <- values[names(values) != "siteid"] + } + + baseURL <- httr2::req_url_query(baseURL, + !!!values, + .multi = "explode") + withCallingHandlers( { retval <- importWQP(baseURL, diff --git a/man/getWebServiceData.Rd b/man/getWebServiceData.Rd index 5e2d0571..9b685fb4 100644 --- a/man/getWebServiceData.Rd +++ b/man/getWebServiceData.Rd @@ -15,8 +15,7 @@ getWebServiceData(obs_url, ...) raw data from web services } \description{ -This function accepts a url parameter, and returns the raw data. The function enhances -\code{\link[httr]{GET}} with more informative error messages. +This function accepts a url parameter, and returns the raw data. } \examples{ \dontshow{if (is_dataRetrieval_user()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} diff --git a/man/readWQPdata.Rd b/man/readWQPdata.Rd index fc46f012..8099e97f 100644 --- a/man/readWQPdata.Rd +++ b/man/readWQPdata.Rd @@ -215,6 +215,17 @@ Phosphorus <- readWQPdata( ignore_attributes = TRUE, convertType = FALSE ) + +rawPHsites_legacy <- readWQPdata(siteid = c("USGS-05406450", "USGS-05427949", "WIDNR_WQX-133040"), + characteristicName = "pH", + service = "Result", + dataProfile = "narrowResult" ) + +rawPHsites <- readWQPdata(siteid = c("USGS-05406450", "USGS-05427949", "WIDNR_WQX-133040"), + characteristicName = "pH", + service = "ResultWQX3", + dataProfile = "narrow" ) + } \dontshow{\}) # examplesIf} } diff --git a/man/whatWQPdata.Rd b/man/whatWQPdata.Rd index 65a4adf6..f2f97880 100644 --- a/man/whatWQPdata.Rd +++ b/man/whatWQPdata.Rd @@ -4,7 +4,7 @@ \alias{whatWQPdata} \title{Data Available from Water Quality Portal} \usage{ -whatWQPdata(..., saveFile = tempfile(), convertType = TRUE) +whatWQPdata(..., convertType = TRUE) } \arguments{ \item{\dots}{see \url{https://www.waterqualitydata.us/webservices_documentation} for @@ -20,8 +20,6 @@ in the Query URL. The corresponding argument for dataRetrieval is characteristicType = "Nutrient". dataRetrieval users do not need to include mimeType, and providers is optional (these arguments are picked automatically).} -\item{saveFile}{path to save the incoming geojson output.} - \item{convertType}{logical, defaults to \code{TRUE}. If \code{TRUE}, the function will convert the data to dates, datetimes, numerics based on a standard algorithm. If false, everything is returned as a character.} From 9fca4e2e94a011bf5c57757ba832a67bc4a0de93 Mon Sep 17 00:00:00 2001 From: Laura A DeCicco Date: Mon, 4 Nov 2024 11:00:59 -0600 Subject: [PATCH 09/30] a few httr2 updates --- R/importRDB1.R | 13 +++++++++---- R/importWaterML1.R | 6 +++--- R/pcode_to_name.R | 2 +- R/readWQPdata.R | 2 +- R/readWQPqw.R | 2 +- R/whatNWISsites.R | 2 +- R/whatWQPdata.R | 4 ++-- R/whatWQPsites.R | 4 ++-- man/importWaterML1.Rd | 7 ------- 9 files changed, 20 insertions(+), 22 deletions(-) diff --git a/R/importRDB1.R b/R/importRDB1.R index 198ee493..3b4174ae 100644 --- a/R/importRDB1.R +++ b/R/importRDB1.R @@ -120,8 +120,11 @@ importRDB1 <- function(obs_url, } readr.total <- readLines(temp_file) - + if(readr.total[length(readr.total)] == ""){ + readr.total <- readr.total[-length(readr.total)] + } total.rows <- length(readr.total) + readr.meta <- readr.total[grep("^#", readr.total)] meta.rows <- length(readr.meta) header.names <- strsplit(readr.total[meta.rows + 1], "\t")[[1]] @@ -139,7 +142,7 @@ importRDB1 <- function(obs_url, if (data.rows > 0) { args_list <- list( - file = temp_file, + file = readr.total, #temp_file, delim = "\t", quote = "", skip = meta.rows + 2, @@ -156,8 +159,10 @@ importRDB1 <- function(obs_url, } readr.data <- suppressWarnings(do.call(readr::read_delim, args = args_list)) - - readr.data <- as.data.frame(readr.data) + # + # readr.data <- as.data.frame(readr.data) + readr.data <- as.data.frame(readr.total[seq(from = meta.rows + 3, + to = total.rows)]) if (nrow(readr.data) > 0) { names(readr.data) <- header.names diff --git a/R/importWaterML1.R b/R/importWaterML1.R index 0f19b242..6aae5a14 100644 --- a/R/importWaterML1.R +++ b/R/importWaterML1.R @@ -98,7 +98,7 @@ importWaterML1 <- function(obs_url, asDateTime = FALSE, tz = "UTC") { # note: obs_url is a dated name, does not have to be a url/path returnedDoc <- check_if_xml(obs_url) - raw <- !is.character(obs_url) + raw <- !is.character(obs_url) & !("httr2_request" %in% class(obs_url)) if (tz == "") { # check tz is valid if supplied tz <- "UTC" @@ -125,7 +125,7 @@ importWaterML1 <- function(obs_url, asDateTime = FALSE, tz = "UTC") { ) attr(df, "queryInfo") <- noteList if (!raw) { - attr(df, "url") <- obs_url + attr(df, "url") <- obs_url$url } return(df) } @@ -384,7 +384,7 @@ importWaterML1 <- function(obs_url, asDateTime = FALSE, tz = "UTC") { # attach other site info etc as attributes of mergedDF if (!raw) { - attr(mergedDF, "url") <- obs_url + attr(mergedDF, "url") <- obs_url$url } attr(mergedDF, "siteInfo") <- mergedSite attr(mergedDF, "variableInfo") <- mergedVar diff --git a/R/pcode_to_name.R b/R/pcode_to_name.R index d3a70335..f0691660 100644 --- a/R/pcode_to_name.R +++ b/R/pcode_to_name.R @@ -34,7 +34,7 @@ pcode_to_name <- function(parameterCd = "all"){ retval <- retval[retval$parm_cd %in% parameterCd, ] } - attr(retval, "url") <- url_all + attr(retval, "url") <- url_all$url if(any(parameterCd != "all")){ if (nrow(retval) != length(unique(parameterCd))) { diff --git a/R/readWQPdata.R b/R/readWQPdata.R index ec4ee45e..9eaf118c 100644 --- a/R/readWQPdata.R +++ b/R/readWQPdata.R @@ -271,7 +271,7 @@ readWQPdata <- function(..., retval <- create_WQP_attributes(retval, params) } - attr(retval, "url") <- baseURL + attr(retval, "url") <- baseURL$url if(legacy){ wqp_message() diff --git a/R/readWQPqw.R b/R/readWQPqw.R index 92998f49..9f70964a 100644 --- a/R/readWQPqw.R +++ b/R/readWQPqw.R @@ -101,7 +101,7 @@ readWQPqw <- function(siteNumbers, } else { wqp_message_beta() } - attr(retval, "url") <- url + attr(retval, "url") <- url$url return(retval) } diff --git a/R/whatNWISsites.R b/R/whatNWISsites.R index 6626e337..fdf8ad43 100644 --- a/R/whatNWISsites.R +++ b/R/whatNWISsites.R @@ -99,7 +99,7 @@ whatNWISsites <- function(...) { retVal <- retVal[!duplicated(retVal), ] - attr(retVal, "url") <- urlCall + attr(retVal, "url") <- urlCall$url timenow <- Sys.time() diff --git a/R/whatWQPdata.R b/R/whatWQPdata.R index 749104df..b9ed6a9d 100644 --- a/R/whatWQPdata.R +++ b/R/whatWQPdata.R @@ -60,7 +60,7 @@ whatWQPsamples <- function(..., attr(retval, "legacy") <- legacy attr(retval, "queryTime") <- Sys.time() - attr(retval, "url") <- baseURL + attr(retval, "url") <- baseURL$url if(legacy){ wqp_message() @@ -133,7 +133,7 @@ whatWQPmetrics <- function(..., } else { wqp_message() attr(retval, "queryTime") <- Sys.time() - attr(retval, "url") <- baseURL + attr(retval, "url") <- baseURL$url return(retval) } diff --git a/R/whatWQPsites.R b/R/whatWQPsites.R index 0e91f53a..e9b61885 100644 --- a/R/whatWQPsites.R +++ b/R/whatWQPsites.R @@ -75,7 +75,7 @@ whatWQPsites <- function(..., legacy = TRUE) { if(!is.null(retval)){ attr(retval, "queryTime") <- Sys.time() - attr(retval, "url") <- baseURL + attr(retval, "url") <- baseURL$url } return(retval) @@ -184,7 +184,7 @@ readWQPsummary <- function(...) { if(!is.null(retval)){ attr(retval, "queryTime") <- Sys.time() - attr(retval, "url") <- baseURL + attr(retval, "url") <- baseURL$url } return(retval) diff --git a/man/importWaterML1.Rd b/man/importWaterML1.Rd index 249bf2de..79ed544e 100644 --- a/man/importWaterML1.Rd +++ b/man/importWaterML1.Rd @@ -99,13 +99,6 @@ tzIssue <- importWaterML1(tzURL, asDateTime = TRUE, tz = "America/Chicago" ) -# raw XML -url <- constructNWISURL( - service = "dv", siteNumber = "02319300", parameterCd = "00060", - startDate = "2014-01-01", endDate = "2014-01-01" -) -raw <- httr::content(httr::GET(url), as = "raw") -rawParsed <- importWaterML1(raw) } filePath <- system.file("extdata", package = "dataRetrieval") fileName <- "WaterML1Example.xml" From 313fdda887de693510d377691d4dea3ad0031487 Mon Sep 17 00:00:00 2001 From: Laura A DeCicco Date: Mon, 4 Nov 2024 14:32:02 -0600 Subject: [PATCH 10/30] Fixing some tests. Mostly arguments in the URLs are shuffled around. --- R/constructNWISURL.R | 18 ++++-------------- R/importRDB1.R | 22 ++++++++-------------- R/readNWISdata.R | 4 ++++ tests/testthat/tests_general.R | 28 ++++++++++------------------ 4 files changed, 26 insertions(+), 46 deletions(-) diff --git a/R/constructNWISURL.R b/R/constructNWISURL.R index afec9836..0ef4452b 100644 --- a/R/constructNWISURL.R +++ b/R/constructNWISURL.R @@ -298,6 +298,8 @@ constructWQPURL <- function(siteNumbers, allPCode <- any(toupper(parameterCd) == "ALL") + pCodeLogic <- TRUE + if(!allPCode){ multiplePcodes <- length(parameterCd) > 1 if (all(nchar(parameterCd) == 5)) { @@ -319,16 +321,6 @@ constructWQPURL <- function(siteNumbers, .multi = "explode" ) } - if(!allPCode){ - multiplePcodes <- length(parameterCd) > 1 - - if (all(nchar(parameterCd) == 5)) { - suppressWarnings(pCodeLogic <- all(!is.na(as.numeric(parameterCd)))) - } else { - pCodeLogic <- FALSE - } - } - if(legacy & !allPCode){ if (multiplePcodes) { parameterCd <- paste(parameterCd, collapse = ";") @@ -339,11 +331,9 @@ constructWQPURL <- function(siteNumbers, baseURL <- httr2::req_url_query(baseURL, characteristicName = parameterCd) } - } else if(!legacy & !allPCode){ - parameterCd <- paste0(pcode_name, "=", parameterCd) - - if(pcode_name){ + + if(pCodeLogic){ baseURL <- httr2::req_url_query(baseURL, pCode = parameterCd, .multi = "explode") } else { diff --git a/R/importRDB1.R b/R/importRDB1.R index 3b4174ae..71783b5b 100644 --- a/R/importRDB1.R +++ b/R/importRDB1.R @@ -100,26 +100,22 @@ importRDB1 <- function(obs_url, tz <- match.arg(tz, OlsonNames()) if(class(obs_url) == "httr2_request"){ - temp_file <- tempfile() - on.exit(unlink(temp_file)) - + doc <- getWebServiceData(obs_url) - write(doc, file = temp_file) - if (is.null(temp_file)) { + + if (is.null(doc)) { return(invisible(NULL)) } } else { - if (file.exists(obs_url)){ - temp_file <- obs_url - } else { + if (!file.exists(obs_url)){ warning("Unknown Input") return(NULL) } } - readr.total <- readLines(temp_file) + readr.total <- readr::read_lines(doc) if(readr.total[length(readr.total)] == ""){ readr.total <- readr.total[-length(readr.total)] } @@ -142,7 +138,7 @@ importRDB1 <- function(obs_url, if (data.rows > 0) { args_list <- list( - file = readr.total, #temp_file, + file = doc, delim = "\t", quote = "", skip = meta.rows + 2, @@ -159,10 +155,8 @@ importRDB1 <- function(obs_url, } readr.data <- suppressWarnings(do.call(readr::read_delim, args = args_list)) - # - # readr.data <- as.data.frame(readr.data) - readr.data <- as.data.frame(readr.total[seq(from = meta.rows + 3, - to = total.rows)]) + + readr.data <- as.data.frame(readr.data) if (nrow(readr.data) > 0) { names(readr.data) <- header.names diff --git a/R/readNWISdata.R b/R/readNWISdata.R index 4a2727a5..c1d18990 100644 --- a/R/readNWISdata.R +++ b/R/readNWISdata.R @@ -501,6 +501,10 @@ readNWISdots <- function(...) { } + if("bbox" %in% names(values)){ + values[["bbox"]] <- paste0(values[["bbox"]], collapse = ",") + } + if (service %in% c("peak", "gwlevels") && "stateCd" %in% names(values)) { names(values)[names(values) == "stateCd"] <- "state_cd" values["list_of_search_criteria"] <- "state_cd" diff --git a/tests/testthat/tests_general.R b/tests/testthat/tests_general.R index ef2af407..8720670a 100644 --- a/tests/testthat/tests_general.R +++ b/tests/testthat/tests_general.R @@ -67,7 +67,7 @@ test_that("General NWIS retrievals working", { expect_true(nrow(gw_data) > 0) expect_equal(attr(gw_data, "url"), - "https://nwis.waterdata.usgs.gov/nwis/gwlevels?state_cd=AL&begin_date=2024-05-01&end_date=2024-05-30&date_format=YYYY-MM-DD&rdb_inventory_output=file&TZoutput=0&range_selection=date_range&list_of_search_criteria=state_cd&format=rdb") + "https://nwis.waterdata.usgs.gov/nwis/gwlevels?format=rdb&state_cd=AL&begin_date=2024-05-01&end_date=2024-05-30&date_format=YYYY-MM-DD&rdb_inventory_output=file&TZoutput=0&range_selection=date_range&list_of_search_criteria=state_cd") gw_data2 <- readNWISdata( state_cd = "AL", @@ -78,7 +78,7 @@ test_that("General NWIS retrievals working", { expect_equal(nrow(gw_data), nrow(gw_data2)) # nolint start: line_length_linter - url <- "https://waterservices.usgs.gov/nwis/dv/?site=09037500&format=rdb&ParameterCd=00060&StatCd=00003&startDT=1985-10-02&endDT=2012-09-06" + url <- httr2::request("https://waterservices.usgs.gov/nwis/dv/?site=09037500&format=rdb&ParameterCd=00060&StatCd=00003&startDT=1985-10-02&endDT=2012-09-06") dv <- importRDB1(url, asDateTime = FALSE) # nolint end dailyStat <- readNWISdata( @@ -102,7 +102,7 @@ test_that("General NWIS retrievals working", { # Empty data # note....not empty anymore! # nolint start: line_length_linter - urlTest <- "https://nwis.waterservices.usgs.gov/nwis/iv/?site=11447650&format=waterml,1.1&ParameterCd=63680&startDT=2016-12-13&endDT=2016-12-13" + urlTest <- httr2::request("https://nwis.waterservices.usgs.gov/nwis/iv/?site=11447650&format=waterml,1.1&ParameterCd=63680&startDT=2016-12-13&endDT=2016-12-13") x <- importWaterML1(urlTest) expect_true(all(c("agency_cd", "site_no", "dateTime", "tz_cd") %in% names(x))) # nolint end @@ -378,7 +378,7 @@ test_that("whatNWISsites working", { #gwlevels: info <- whatNWISsites(stateCd = "NY", service="gwlevels") expect_true(nrow(info) > 0) - expect_equal(attr(info, "url"), "https://waterservices.usgs.gov/nwis/site/?stateCd=NY&format=mapper&hasDataTypeCd=gw") + expect_equal(attr(info, "url"), "https://waterservices.usgs.gov/nwis/site/?stateCd=NY&hasDataTypeCd=gw&format=mapper") }) context("readWQPdots") @@ -388,7 +388,7 @@ test_that("readWQPdots working", { # bbox vector turned into single string with coords separated by semicolons formArgs_bbox <- dataRetrieval:::readWQPdots(bbox = c(-92.5, 45.4, -87, 47)) expect_true(length(formArgs_bbox) == 2) - expect_true(length(gregexpr(",", formArgs_bbox)[[1]]) == 3) + expect_true(length(formArgs_bbox$values$bBox) == 1) # NWIS names (siteNumber) converted to WQP expected names (siteid) formArgs_site <- dataRetrieval:::readWQPdots(siteNumber = "04010301") @@ -411,8 +411,8 @@ test_that("readWQPdots working", { characteristicName = "Total Coliform", startDateLo = "2023-01-01", startDateHi = "2023-12-31", - service = "ResultWQX3", - dataProfile = "narrow") + service = "Result", + dataProfile = "narrowResult") expect_true(nrow(df) > 0) df_legacy <- readWQPdata(bBox = bbox, characteristicName = "Total Coliform", @@ -463,14 +463,6 @@ test_that("ngwmn urls don't use post", { ) }) -test_that("400 errors return a verbose error", { - testthat::skip_on_cran() - # nolint start: line_length_linter - url <- "https://waterservices.usgs.gov/nwis/site/?stateCd=IA&bBox=-92.821445,42.303044,-92.167168,42.646524&format=mapper" - # nolint end - expect_message(getWebServiceData(url)) -}) - test_that("internal functions", { # get empty_col type @@ -681,7 +673,7 @@ test_that("readWQPsummary", { # nolint start: line_length_linter expect_equal( attr(site1, "url"), - "https://www.waterqualitydata.us/data/summary/monitoringLocation/search?siteid=USGS-07144100&summaryYears=5&dataProfile=periodOfRecord&mimeType=csv" + "https://www.waterqualitydata.us/data/summary/monitoringLocation/search?siteid=USGS-07144100&summaryYears=5&mimeType=csv&dataProfile=periodOfRecord" ) # nolint end }) @@ -703,8 +695,8 @@ test_that("importWQP convertType", { # expect_is(phos$Result_Measure, "character") SC <- readWQPqw(siteNumbers = "USGS-05288705", parameterCd = "00300", - convertType = FALSE, legacy = FALSE) - expect_is(SC$Result_Measure, "character") + convertType = FALSE, legacy = TRUE) + expect_is(SC$ResultMeasureValue, "character") lakeSites_chars <- whatWQPdata( siteType = "Lake, Reservoir, Impoundment", From f09bb35133339e8b119f081405e313385124860d Mon Sep 17 00:00:00 2001 From: Laura A DeCicco Date: Mon, 4 Nov 2024 14:39:04 -0600 Subject: [PATCH 11/30] wrong argument --- R/readNWISsite.R | 2 +- R/readNWISunit.R | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/readNWISsite.R b/R/readNWISsite.R index 77ceab9e..9e728e41 100644 --- a/R/readNWISsite.R +++ b/R/readNWISsite.R @@ -73,7 +73,7 @@ readNWISsite <- function(siteNumbers) { format = "rdb") urlSitefile <- httr2::req_url_query(urlSitefile, - site = siteNumber, + site = siteNumbers, .multi = "comma") data <- importRDB1(urlSitefile, asDateTime = FALSE) diff --git a/R/readNWISunit.R b/R/readNWISunit.R index 4ec6b154..b3fea426 100644 --- a/R/readNWISunit.R +++ b/R/readNWISunit.R @@ -284,7 +284,7 @@ readNWISrating <- function(siteNumber, type = "base", convertType = TRUE) { attr(data, "RATING") <- Rat } - siteInfo <- suppressMessages(readNWISsite(siteNumber)) + siteInfo <- suppressMessages(readNWISsite(siteNumbers = siteNumber)) attr(data, "siteInfo") <- siteInfo attr(data, "variableInfo") <- NULL From 90cb26cadf41f94a9c02f8ef26a50cb7e69a95d4 Mon Sep 17 00:00:00 2001 From: Laura A DeCicco Date: Mon, 4 Nov 2024 15:18:39 -0600 Subject: [PATCH 12/30] More tests to fix and update findNLDI --- R/constructNWISURL.R | 4 +++- R/findNLDI.R | 26 +++++++++++++----------- tests/testthat/tests_general.R | 2 +- tests/testthat/tests_imports.R | 3 ++- tests/testthat/tests_userFriendly_fxns.R | 4 ++-- 5 files changed, 22 insertions(+), 17 deletions(-) diff --git a/R/constructNWISURL.R b/R/constructNWISURL.R index 0ef4452b..80a90ad2 100644 --- a/R/constructNWISURL.R +++ b/R/constructNWISURL.R @@ -123,7 +123,9 @@ constructNWISURL <- function(siteNumbers, measurements = { url <- httr2::req_url_query(baseURL, site_no = siteNumbers, - range_selection = "date_range" + .multi = "comma") + url <- httr2::req_url_query(url, + range_selection = "date_range" ) if (nzchar(startDate)) { url <- httr2::req_url_query(url, diff --git a/R/findNLDI.R b/R/findNLDI.R index 60911475..2438f40f 100644 --- a/R/findNLDI.R +++ b/R/findNLDI.R @@ -43,17 +43,15 @@ find_good_names <- function(input, type) { #' get_nldi_sources() #' } get_nldi_sources <- function(url = pkg.env$nldi_base) { - res <- - httr::RETRY("GET", - url, - times = 3, - pause_cap = 60 - ) + res <- httr2::request(url) + res <- httr2::req_user_agent(res, default_ua()) + res <- httr2::req_throttle(res, rate = 30 / 60) + res <- httr2::req_retry(res, + backoff = ~ 5, max_tries = 3) + res <- httr2::req_perform(res) if (res$status_code == 200) { - jsonlite::fromJSON(httr::content(res, "text", - encoding = "UTF8" - ), + jsonlite::fromJSON(httr2::resp_body_string(res), simplifyDataFrame = TRUE ) } else { @@ -84,13 +82,17 @@ get_nldi_sources <- function(url = pkg.env$nldi_base) { get_nldi <- function(url, type = "", use_sf = FALSE, warn = TRUE) { # Query - - res <- httr::RETRY("GET", url = url, times = 3, pause_cap = 60, quiet = TRUE) + res <- httr2::request(url) + res <- httr2::req_user_agent(res, default_ua()) + res <- httr2::req_throttle(res, rate = 30 / 60) + res <- httr2::req_retry(res, + backoff = ~ 5, max_tries = 3) + res <- httr2::req_perform(res) # If successful ... if (res$status_code == 200) { # Interpret as text - d <- httr::content(res, "text", encoding = "UTF8") + d <- httr2::resp_body_string(res) if (d == "") { diff --git a/tests/testthat/tests_general.R b/tests/testthat/tests_general.R index 8720670a..3a7e5e25 100644 --- a/tests/testthat/tests_general.R +++ b/tests/testthat/tests_general.R @@ -398,7 +398,7 @@ test_that("readWQPdots working", { # NWIS names (stateCd) converted to WQP expected names (statecode) formArgs <- dataRetrieval:::readWQPdots(stateCd = "OH", parameterCd = "00665") - expect_true(length(formArgs$values) == 2) + expect_true(length(formArgs$values) == 3) expect_true("statecode" %in% names(formArgs$values)) expect_false("stateCd" %in% names(formArgs$values)) diff --git a/tests/testthat/tests_imports.R b/tests/testthat/tests_imports.R index 652c0e2f..e3f13ce3 100644 --- a/tests/testthat/tests_imports.R +++ b/tests/testthat/tests_imports.R @@ -151,7 +151,8 @@ test_that("External importWaterML1 test", { service = "dv", siteNumber = "02319300", parameterCd = "00060", startDate = "2014-01-01", endDate = "2014-01-01" ) - raw <- httr::content(httr::GET(url), as = "raw") + raw <- httr2::req_perform(url) + raw <- httr2::resp_body_xml(raw) rawParsed <- importWaterML1(raw) expect_true(nrow(rawParsed) > 0) expect_true(data.class(rawParsed$X_00060_00003) == "numeric") diff --git a/tests/testthat/tests_userFriendly_fxns.R b/tests/testthat/tests_userFriendly_fxns.R index 1f7f5ae6..f2341e13 100644 --- a/tests/testthat/tests_userFriendly_fxns.R +++ b/tests/testthat/tests_userFriendly_fxns.R @@ -35,7 +35,7 @@ test_that("Unit value data returns correct types", { # nolint start: line_length_linter expect_equal( attr(rawData, "url"), - "https://nwis.waterservices.usgs.gov/nwis/iv/?site=05114000&format=waterml,1.1&ParameterCd=00060&startDT=2014-10-10&endDT=2014-10-10" + "https://nwis.waterservices.usgs.gov/nwis/iv/?site=05114000&format=waterml%2C1.1&ParameterCd=00060&startDT=2014-10-10&endDT=2014-10-10" ) # nolint end timeZoneChange <- readNWISuv(c("04024430", "04024000"), parameterCd, @@ -48,7 +48,7 @@ test_that("Unit value data returns correct types", { expect_is(rawData$dateTime, "POSIXct") expect_is(rawData$Flow_Inst, "numeric") # nolint start: line_length_linter - expect_equal(attr(rawData, "url"), "https://nwis.waterservices.usgs.gov/nwis/iv/?site=05114000&format=waterml,1.1&ParameterCd=00060&startDT=2014-10-10&endDT=2014-10-10") + expect_equal(attr(rawData, "url"), "https://nwis.waterservices.usgs.gov/nwis/iv/?site=05114000&format=waterml%2C1.1&ParameterCd=00060&startDT=2014-10-10&endDT=2014-10-10") # nolint end site <- "04087170" pCode <- "63680" From 746d32cf37697cb543bd632a5f2a19eb1c599f9a Mon Sep 17 00:00:00 2001 From: Laura A DeCicco Date: Mon, 4 Nov 2024 15:29:35 -0600 Subject: [PATCH 13/30] local file tests --- R/importRDB1.R | 2 +- R/setAccess.R | 26 ------------ tests/testthat/tests_general.R | 74 +++++++++++++++++----------------- tests/testthat/tests_imports.R | 28 ------------- 4 files changed, 38 insertions(+), 92 deletions(-) diff --git a/R/importRDB1.R b/R/importRDB1.R index 71783b5b..67d95416 100644 --- a/R/importRDB1.R +++ b/R/importRDB1.R @@ -112,7 +112,7 @@ importRDB1 <- function(obs_url, warning("Unknown Input") return(NULL) } - + doc <- obs_url } readr.total <- readr::read_lines(doc) diff --git a/R/setAccess.R b/R/setAccess.R index c1ea4bad..d5019be1 100644 --- a/R/setAccess.R +++ b/R/setAccess.R @@ -72,29 +72,3 @@ setAccess <- function(access = "public") { # nolint end } -drURL <- function(base.name, ..., arg.list = NULL) { - queryString <- drQueryArgs(..., arg.list = arg.list) - # to do: add something to check for redundant params - - return(paste0(pkg.env[[base.name]], "?", queryString)) -} - -drQueryArgs <- function(..., arg.list) { - dots <- list(...) - dots <- dots[!vapply(X = dots, FUN = is.null, FUN.VALUE = TRUE)] - - args <- append(expand.grid(dots, stringsAsFactors = FALSE), arg.list) - # get the args into name=value strings - keyValues <- paste0(names(args), unname(lapply(args, function(x) paste0("=", x[[1]])))) - return(paste(keyValues, collapse = "&")) -} - -appendDrURL <- function(url, ..., arg.list = NULL) { - queryString <- drQueryArgs(..., arg.list = arg.list) - if (length(strsplit(url, "\\?")[[1]]) > 1) { - return_url <- paste0(url, "&", queryString) - } else { - return_url <- paste0(url, queryString) - } - return(return_url) -} diff --git a/tests/testthat/tests_general.R b/tests/testthat/tests_general.R index 3a7e5e25..b331eefe 100644 --- a/tests/testthat/tests_general.R +++ b/tests/testthat/tests_general.R @@ -425,43 +425,43 @@ test_that("readWQPdots working", { context("getWebServiceData") -test_that("long urls use POST", { - testthat::skip_on_cran() - baseURL <- dataRetrieval:::drURL("Result") - url <- paste0(baseURL, - rep("reallylongurl", 200), - collapse = "" - ) - with_mock( - RETRY = function(method, ...) { - return(method == "POST") - }, - status_code = function(resp) 200, - headers = function(resp) list(`content-type` = "logical"), - content = function(resp, encoding) resp, - expect_true(getWebServiceData(url)), - .env = "httr" - ) -}) - -test_that("ngwmn urls don't use post", { - testthat::skip_on_cran() - baseURL <- dataRetrieval:::drURL("NGWMN") - url <- paste0(baseURL, - rep("urlwithngwmn", 200), - collapse = "" - ) - with_mock( - RETRY = function(method, ...) { - return(method == "POST") - }, - status_code = function(resp) 200, - headers = function(resp) list(`content-type` = "logical"), - content = function(resp, encoding) resp, - expect_false(getWebServiceData(url)), - .env = "httr" - ) -}) +# test_that("long urls use POST", { +# testthat::skip_on_cran() +# baseURL <- dataRetrieval:::drURL("Result") +# url <- paste0(baseURL, +# rep("reallylongurl", 200), +# collapse = "" +# ) +# with_mock( +# RETRY = function(method, ...) { +# return(method == "POST") +# }, +# status_code = function(resp) 200, +# headers = function(resp) list(`content-type` = "logical"), +# content = function(resp, encoding) resp, +# expect_true(getWebServiceData(url)), +# .env = "httr" +# ) +# }) +# +# test_that("ngwmn urls don't use post", { +# testthat::skip_on_cran() +# baseURL <- dataRetrieval:::drURL("NGWMN") +# url <- paste0(baseURL, +# rep("urlwithngwmn", 200), +# collapse = "" +# ) +# with_mock( +# RETRY = function(method, ...) { +# return(method == "POST") +# }, +# status_code = function(resp) 200, +# headers = function(resp) list(`content-type` = "logical"), +# content = function(resp, encoding) resp, +# expect_false(getWebServiceData(url)), +# .env = "httr" +# ) +# }) test_that("internal functions", { diff --git a/tests/testthat/tests_imports.R b/tests/testthat/tests_imports.R index e3f13ce3..ffdae6f9 100644 --- a/tests/testthat/tests_imports.R +++ b/tests/testthat/tests_imports.R @@ -36,34 +36,6 @@ test_that("External importRDB1 tests", { site <- "05427850" - url <- constructNWISURL(site, "00060", "2015-01-01", "", "dv", - format = "tsv", - statCd = "laksjd" - ) - # And....now there"s data there: - expect_null(importRDB1(url)) - - site <- "11486500" - - url <- dataRetrieval:::drURL("site", arg.list = list( - siteOutput = "Expanded", - format = "rdb", - site = site - )) - site_data <- importRDB1(url) - - expect_equal(site_data$station_nm, "G CANAL NEAR OLENE, OR") - - site <- "040854588204" - - url <- dataRetrieval:::drURL("site", arg.list = list( - siteOutput = "Expanded", - format = "rdb", - site = site - )) - site_data <- importRDB1(url) - - expect_equal(site_data$station_nm, "FISHER CR AT 32 & HIGHLAND RD AT HOWARDS GROVE, W") }) context("importRDB") From 47e35a72333671933c0c3e2f771049a21b2e3e3e Mon Sep 17 00:00:00 2001 From: Laura A DeCicco Date: Tue, 5 Nov 2024 07:24:20 -0600 Subject: [PATCH 14/30] getting water use URLs to work --- R/constructNWISURL.R | 41 +++++++++++++++--------- R/importWaterML1.R | 2 +- R/pcode_to_name.R | 2 +- R/readNWISpCode.R | 16 +++++---- tests/testthat/tests_nldi.R | 4 +-- tests/testthat/tests_userFriendly_fxns.R | 19 +++++------ 6 files changed, 50 insertions(+), 34 deletions(-) diff --git a/R/constructNWISURL.R b/R/constructNWISURL.R index 80a90ad2..e3ae933f 100644 --- a/R/constructNWISURL.R +++ b/R/constructNWISURL.R @@ -389,30 +389,41 @@ constructWQPURL <- function(siteNumbers, #' ) #' constructUseURL <- function(years, stateCd, countyCd, categories) { + + if (is.null(stateCd)) { - baseURL <- drURL("useNat", - format = "rdb", - rdb_compression = "value", - Access = pkg.env$access - ) + baseURL <- httr2::request(pkg.env[["useNat"]]) + baseURL <- httr2::req_url_query(baseURL, + format = "rdb", + rdb_compression = "value") } else { + stateCd <- stateCdLookup(input = stateCd, outputType = "postal") - baseURL <- "https://waterdata.usgs.gov/" - base2 <- "nwis/water_use?format=rdb&rdb_compression=value" - baseURL <- paste0(baseURL, paste0(stateCd, "/"), base2) + baseURL <- httr2::request("https://waterdata.usgs.gov/") + baseURL <- httr2::req_url_path_append(baseURL, stateCd) + baseURL <- httr2::req_url_path_append(baseURL, + "nwis", "water_use") + baseURL <- httr2::req_url_query(baseURL, + format = "rdb", + rdb_compression = "value") - if (!is.null(countyCd)) { + if (!(is.null(countyCd) )) { if (length(countyCd) > 1) { countyCd <- paste(countyCd, collapse = "%2C") } - baseURL <- paste0(baseURL, "&wu_area=county&wu_county=", countyCd) + baseURL <- httr2::req_url_query(baseURL, + wu_area = "county", + wu_county = countyCd) } else { - baseURL <- paste0(baseURL, "&wu_area=State%20Total") + baseURL <- httr2::req_url_query(baseURL, + wu_area = "State Total") } } - years <- paste(years, collapse = "%2C") - categories <- paste(categories, collapse = "%2C") - retURL <- paste0(baseURL, "&wu_year=", years, "&wu_category=", categories) + + baseURL <- httr2::req_url_query(baseURL, + wu_year = years, + .multi = "comma") + baseURL <- httr2::req_url_query(baseURL, wu_category = categories) - return(retURL) + return(baseURL) } \ No newline at end of file diff --git a/R/importWaterML1.R b/R/importWaterML1.R index 6aae5a14..da9ba20b 100644 --- a/R/importWaterML1.R +++ b/R/importWaterML1.R @@ -383,7 +383,7 @@ importWaterML1 <- function(obs_url, asDateTime = FALSE, tz = "UTC") { names(mergedDF) <- make.names(names(mergedDF)) # attach other site info etc as attributes of mergedDF - if (!raw) { + if ("httr2_request" %in% class(obs_url)) { attr(mergedDF, "url") <- obs_url$url } attr(mergedDF, "siteInfo") <- mergedSite diff --git a/R/pcode_to_name.R b/R/pcode_to_name.R index f0691660..d3a70335 100644 --- a/R/pcode_to_name.R +++ b/R/pcode_to_name.R @@ -34,7 +34,7 @@ pcode_to_name <- function(parameterCd = "all"){ retval <- retval[retval$parm_cd %in% parameterCd, ] } - attr(retval, "url") <- url_all$url + attr(retval, "url") <- url_all if(any(parameterCd != "all")){ if (nrow(retval) != length(unique(parameterCd))) { diff --git a/R/readNWISpCode.R b/R/readNWISpCode.R index 34cb0a57..3723b8f0 100644 --- a/R/readNWISpCode.R +++ b/R/readNWISpCode.R @@ -49,7 +49,7 @@ readNWISpCode <- function(parameterCd) { parameter_units = temp_df$parm_unit, stringsAsFactors = FALSE ) - attr(parameterData, "url") <- fullURL + attr(parameterData, "url") <- fullURL$url } else { parameterData <- parameterCdFile[parameterCdFile$parameter_cd %in% parameterCd, ] @@ -59,9 +59,13 @@ readNWISpCode <- function(parameterCd) { if (length(parameterCd_lookup) == 1) { - baseURL <- drURL("pCodeSingle", Access = pkg.env$access) - subURL <- paste0(baseURL, "fmt=rdb&parm_nm_cd=", parameterCd_lookup) - temp_df <- importRDB1(subURL, asDateTime = FALSE) + baseURL <- httr2::request(pkg.env[["pCodeSingle"]]) + baseURL <- httr2::req_url_query(baseURL, + fmt = "rdb") + baseURL <- httr2::req_url_query(baseURL, + parm_nm_cd = parameterCd_lookup) + + temp_df <- importRDB1(baseURL, asDateTime = FALSE) temp_df <- data.frame( parameter_cd = temp_df$parameter_cd, @@ -77,7 +81,7 @@ readNWISpCode <- function(parameterCd) { parameterData <- rbind(parameterData, temp_df) } - attr(parameterData, "url") <- subURL + attr(parameterData, "url") <- baseURL$url } else { temp_df <- importRDB1(fullURL, asDateTime = FALSE) trim_df <- data.frame( @@ -90,7 +94,7 @@ readNWISpCode <- function(parameterCd) { stringsAsFactors = FALSE ) parameterData <- trim_df[trim_df$parameter_cd %in% parameterCd, ] - attr(parameterData, "url") <- fullURL + attr(parameterData, "url") <- fullURL$url } if (nrow(parameterData) != length(parameterCd)) { diff --git a/tests/testthat/tests_nldi.R b/tests/testthat/tests_nldi.R index 1231a753..29f68414 100644 --- a/tests/testthat/tests_nldi.R +++ b/tests/testthat/tests_nldi.R @@ -63,7 +63,7 @@ test_that("NLDI starting sources...", { # ERROR: TWO STARTS expect_error(findNLDI(nwis = 1000, comid = 101, warn = FALSE)) # NON EXISTING SITE - expect_message(findNLDI(comid = 1, warn = FALSE)) + expect_error(findNLDI(comid = 1, warn = FALSE)) }) test_that("NLDI navigation sources...", { @@ -81,7 +81,7 @@ test_that("NLDI navigation sources...", { expect_error(findNLDI(nwis = "11120000", nav = c("DT"), warn = FALSE)) expect_error(findNLDI(nwis = "11120000", nav = c("DT", "UM"), warn = FALSE)) # WARNING: Data not found - expect_warning(findNLDI(comid = 101, nav = "UM", find = "nwis", warn = TRUE)) + expect_error(findNLDI(comid = 101, nav = "UM", find = "nwis", warn = TRUE)) }) test_that("NLDI find sources...", { diff --git a/tests/testthat/tests_userFriendly_fxns.R b/tests/testthat/tests_userFriendly_fxns.R index f2341e13..f31e9b50 100644 --- a/tests/testthat/tests_userFriendly_fxns.R +++ b/tests/testthat/tests_userFriendly_fxns.R @@ -360,18 +360,19 @@ test_that("Construct NWIS urls", { ) # nolint start: line_length_linter - expect_equal(url_daily, "https://waterservices.usgs.gov/nwis/dv/?site=01594440&format=waterml,1.1&ParameterCd=00060,00010&StatCd=00003,00001&startDT=1985-01-01") + expect_equal(url_daily$url, + "https://waterservices.usgs.gov/nwis/dv/?site=01594440&format=waterml%2C1.1&ParameterCd=00060%2C00010&StatCd=00003%2C00001&startDT=1985-01-01") url_unit <- constructNWISURL(siteNumber, pCode, "2012-06-28", "2012-06-30", "iv") expect_equal( - url_unit, - "https://nwis.waterservices.usgs.gov/nwis/iv/?site=01594440&format=waterml,1.1&ParameterCd=00060,00010&startDT=2012-06-28&endDT=2012-06-30" + url_unit$url, + "https://nwis.waterservices.usgs.gov/nwis/iv/?site=01594440&format=waterml%2C1.1&ParameterCd=00060%2C00010&startDT=2012-06-28&endDT=2012-06-30" ) url_daily_tsv <- constructNWISURL(siteNumber, pCode, startDate, endDate, "dv", statCd = c("00003", "00001"), format = "tsv" ) - expect_equal(url_daily_tsv, "https://waterservices.usgs.gov/nwis/dv/?site=01594440&format=rdb,1.0&ParameterCd=00060,00010&StatCd=00003,00001&startDT=1985-01-01") + expect_equal(url_daily_tsv$url, "https://waterservices.usgs.gov/nwis/dv/?site=05114000&format=rdb%2C1.0&ParameterCd=63680&StatCd=00003%2C00001&startDT=2012-07-10&endDT=2012-07-17") url_use <- constructUseURL( years = c(1990, 1995), @@ -379,7 +380,7 @@ test_that("Construct NWIS urls", { countyCd = c(1, 3), categories = "ALL" ) - expect_equal(url_use, "https://waterdata.usgs.gov/OH/nwis/water_use?format=rdb&rdb_compression=value&wu_area=county&wu_county=1%2C3&wu_year=1990%2C1995&wu_category=ALL") + expect_equal(url_use$url, "https://waterdata.usgs.gov/OH/nwis/water_use?format=rdb&rdb_compression=value&wu_area=county&wu_county=1%252C3&wu_year=1990%252C1995&wu_category=ALL") # nolint end }) @@ -398,7 +399,7 @@ test_that("Construct WQP urls", { startDate, endDate, legacy = FALSE) # nolint start: line_length_linter expect_equal( - url_wqp, + url_wqp$url, "https://www.waterqualitydata.us/wqx3/Result/search?siteid=USGS-01594440&pCode=01075&pCode=00029&pCode=00453&startDateLo=01-01-1985&mimeType=csv&dataProfile=basicPhysChem" ) @@ -414,7 +415,7 @@ test_that("Construct WQP urls", { startDate = "", endDate = "", legacy = FALSE) expect_equal( - obs_url_orig, + obs_url_orig$url, "https://www.waterqualitydata.us/wqx3/Result/search?siteid=IIDFG-41WSSPAHS&siteid=USGS-02352560&characteristicName=Temperature&characteristicName=Temperature%2C%20sample&characteristicName=Temperature%2C%20water&characteristicName=Temperature%2C%20water%2C%20deg%20F&mimeType=csv&dataProfile=basicPhysChem" ) @@ -434,7 +435,7 @@ test_that("Construct WQP urls", { # nolint start: line_length_linter expect_equal( - url_wqp, + url_wqp$url, "https://www.waterqualitydata.us/wqx3/Result/search?siteid=USGS-01594440&pCode=01075&pCode=00029&pCode=00453&startDateLo=01-01-1985&mimeType=csv&dataProfile=basicPhysChem" ) @@ -464,7 +465,7 @@ test_that("pCode Stuff", { expect_true(nrow(paramINFO) > 20000) expect_equal( attr(paramINFO, "url"), - "https://help.waterdata.usgs.gov/code/parameter_cd_query?fmt=rdb&group_cd=%" + "https://help.waterdata.usgs.gov/code/parameter_cd_query?fmt=rdb&group_cd=%25" ) }) From 790f92493e74a0e0a8162e79cc6fe003ee7f09ad Mon Sep 17 00:00:00 2001 From: Laura A DeCicco Date: Tue, 5 Nov 2024 07:49:50 -0600 Subject: [PATCH 15/30] more test url updates --- R/constructNWISURL.R | 10 +++++----- tests/testthat/tests_userFriendly_fxns.R | 7 +++++-- 2 files changed, 10 insertions(+), 7 deletions(-) diff --git a/R/constructNWISURL.R b/R/constructNWISURL.R index e3ae933f..d5730a44 100644 --- a/R/constructNWISURL.R +++ b/R/constructNWISURL.R @@ -408,12 +408,12 @@ constructUseURL <- function(years, stateCd, countyCd, categories) { rdb_compression = "value") if (!(is.null(countyCd) )) { - if (length(countyCd) > 1) { - countyCd <- paste(countyCd, collapse = "%2C") - } + baseURL <- httr2::req_url_query(baseURL, - wu_area = "county", - wu_county = countyCd) + wu_area = "county") + baseURL <- httr2::req_url_query(baseURL, + wu_county = countyCd, + .multi = "comma") } else { baseURL <- httr2::req_url_query(baseURL, wu_area = "State Total") diff --git a/tests/testthat/tests_userFriendly_fxns.R b/tests/testthat/tests_userFriendly_fxns.R index f31e9b50..132454e9 100644 --- a/tests/testthat/tests_userFriendly_fxns.R +++ b/tests/testthat/tests_userFriendly_fxns.R @@ -354,6 +354,7 @@ test_that("Construct NWIS urls", { startDate <- "1985-01-01" endDate <- "" pCode <- c("00060", "00010") + url_daily <- constructNWISURL(siteNumber, pCode, startDate, endDate, "dv", statCd = c("00003", "00001") @@ -364,6 +365,7 @@ test_that("Construct NWIS urls", { "https://waterservices.usgs.gov/nwis/dv/?site=01594440&format=waterml%2C1.1&ParameterCd=00060%2C00010&StatCd=00003%2C00001&startDT=1985-01-01") url_unit <- constructNWISURL(siteNumber, pCode, "2012-06-28", "2012-06-30", "iv") + expect_equal( url_unit$url, "https://nwis.waterservices.usgs.gov/nwis/iv/?site=01594440&format=waterml%2C1.1&ParameterCd=00060%2C00010&startDT=2012-06-28&endDT=2012-06-30" @@ -372,7 +374,8 @@ test_that("Construct NWIS urls", { url_daily_tsv <- constructNWISURL(siteNumber, pCode, startDate, endDate, "dv", statCd = c("00003", "00001"), format = "tsv" ) - expect_equal(url_daily_tsv$url, "https://waterservices.usgs.gov/nwis/dv/?site=05114000&format=rdb%2C1.0&ParameterCd=63680&StatCd=00003%2C00001&startDT=2012-07-10&endDT=2012-07-17") + + expect_equal(url_daily_tsv$url, "https://waterservices.usgs.gov/nwis/dv/?site=01594440&format=rdb%2C1.0&ParameterCd=00060%2C00010&StatCd=00003%2C00001&startDT=1985-01-01") url_use <- constructUseURL( years = c(1990, 1995), @@ -380,7 +383,7 @@ test_that("Construct NWIS urls", { countyCd = c(1, 3), categories = "ALL" ) - expect_equal(url_use$url, "https://waterdata.usgs.gov/OH/nwis/water_use?format=rdb&rdb_compression=value&wu_area=county&wu_county=1%252C3&wu_year=1990%252C1995&wu_category=ALL") + expect_equal(url_use$url, "https://waterdata.usgs.gov/OH/nwis/water_use?format=rdb&rdb_compression=value&wu_area=county&wu_county=1%2C3&wu_year=1990%2C1995&wu_category=ALL") # nolint end }) From 82318a94c1aad758cdb6b84803df133e4ba0cfc3 Mon Sep 17 00:00:00 2001 From: Laura A DeCicco Date: Tue, 5 Nov 2024 08:06:41 -0600 Subject: [PATCH 16/30] everything except NGWMN working --- R/constructNWISURL.R | 7 +------ R/importRDB1.R | 4 ++-- R/importWQP.R | 4 ++-- man/constructNWISURL.Rd | 5 ----- 4 files changed, 5 insertions(+), 15 deletions(-) diff --git a/R/constructNWISURL.R b/R/constructNWISURL.R index d5730a44..44f51fa6 100644 --- a/R/constructNWISURL.R +++ b/R/constructNWISURL.R @@ -52,11 +52,6 @@ #' ) #' url_unit <- constructNWISURL(site_id, pCode, "2012-06-28", "2012-06-30", "iv") #' -#' url_qw_single <- constructNWISURL(site_id, "01075", startDate, endDate, "qw") -#' url_qw <- constructNWISURL( -#' site_id, c("01075", "00029", "00453"), -#' startDate, endDate, "qw" -#' ) #' url_daily_tsv <- constructNWISURL(site_id, pCode, startDate, endDate, "dv", #' statCd = c("00003", "00001"), format = "tsv" #' ) @@ -78,7 +73,7 @@ constructNWISURL <- function(siteNumbers, statType = "mean") { service <- match.arg(service, c( - "dv", "uv", "iv", "iv_recent", "qw", "gwlevels", + "dv", "uv", "iv", "iv_recent", "gwlevels", "rating", "peak", "meas", "stat")) service[service == "meas"] <- "measurements" diff --git a/R/importRDB1.R b/R/importRDB1.R index 67d95416..36419be4 100644 --- a/R/importRDB1.R +++ b/R/importRDB1.R @@ -99,7 +99,7 @@ importRDB1 <- function(obs_url, tz <- match.arg(tz, OlsonNames()) - if(class(obs_url) == "httr2_request"){ + if(inherits(obs_url, "httr2_request")){ doc <- getWebServiceData(obs_url) @@ -295,7 +295,7 @@ importRDB1 <- function(obs_url, } attr(readr.data, "queryTime") <- Sys.time() - if (class(obs_url) == "httr2_request") { + if (inherits(obs_url, "httr2_request")) { attr(readr.data, "url") <- obs_url$url attr(readr.data, "headerInfo") <- attr(doc, "headerInfo") } diff --git a/R/importWQP.R b/R/importWQP.R index 2f9282c6..4a547ee9 100644 --- a/R/importWQP.R +++ b/R/importWQP.R @@ -45,7 +45,7 @@ importWQP <- function(obs_url, tz = "UTC", tz <- "UTC" } - if (class(obs_url) == "httr2_request") { + if (inherits(obs_url, "httr2_request")) { doc <- getWebServiceData(obs_url) if (is.null(doc)) { return(invisible(NULL)) @@ -74,7 +74,7 @@ importWQP <- function(obs_url, tz = "UTC", if(convertType){ retval <- parse_WQP(retval, tz) } - if (class(obs_url) == "httr2_request") { + if (inherits(obs_url, "httr2_request")) { attr(retval, "headerInfo") <- headerInfo } return(retval) diff --git a/man/constructNWISURL.Rd b/man/constructNWISURL.Rd index dd4cc881..48e671fe 100644 --- a/man/constructNWISURL.Rd +++ b/man/constructNWISURL.Rd @@ -83,11 +83,6 @@ url_daily <- constructNWISURL(site_id, pCode, ) url_unit <- constructNWISURL(site_id, pCode, "2012-06-28", "2012-06-30", "iv") -url_qw_single <- constructNWISURL(site_id, "01075", startDate, endDate, "qw") -url_qw <- constructNWISURL( - site_id, c("01075", "00029", "00453"), - startDate, endDate, "qw" -) url_daily_tsv <- constructNWISURL(site_id, pCode, startDate, endDate, "dv", statCd = c("00003", "00001"), format = "tsv" ) From 97920607e91ca14e997f6ee6b690dd39dc8a8efe Mon Sep 17 00:00:00 2001 From: Laura A DeCicco Date: Tue, 5 Nov 2024 08:39:22 -0600 Subject: [PATCH 17/30] NGWMN --- R/getWebServiceData.R | 2 ++ R/importNGWMN_wml2.R | 17 +++++----- R/readNGWMNdata.R | 57 ++++++++++++++++++++-------------- tests/testthat/tests_general.R | 39 ----------------------- 4 files changed, 44 insertions(+), 71 deletions(-) diff --git a/R/getWebServiceData.R b/R/getWebServiceData.R index 14c5e1dd..098f24ed 100644 --- a/R/getWebServiceData.R +++ b/R/getWebServiceData.R @@ -27,6 +27,8 @@ getWebServiceData <- function(obs_url, ...) { obs_url <- httr2::req_throttle(obs_url, rate = 30 / 60) obs_url <- httr2::req_retry(obs_url, backoff = ~ 5, max_tries = 3) + obs_url <- httr2::req_headers(obs_url, + `Accept-Encoding` = c("compress", "gzip")) print(obs_url) #when happy with httr2, maybe only print url returnedList <- httr2::req_perform(obs_url) diff --git a/R/importNGWMN_wml2.R b/R/importNGWMN_wml2.R index b1489ae7..22eafccc 100644 --- a/R/importNGWMN_wml2.R +++ b/R/importNGWMN_wml2.R @@ -34,18 +34,19 @@ importNGWMN <- function(input, asDateTime = FALSE, tz = "UTC") { } raw <- FALSE - if (is.character(input) && file.exists(input)) { - returnedDoc <- xml2::read_xml(input) - } else if (is.raw(input)) { - returnedDoc <- xml2::read_xml(input) - raw <- TRUE - } else { - returnedDoc <- getWebServiceData(input, encoding = "gzip") + + if(inherits(input, "httr2_request")){ + returnedDoc <- getWebServiceData(input) if (is.null(returnedDoc)) { return(invisible(NULL)) } returnedDoc <- xml2::xml_root(returnedDoc) - } + } else if (is.character(input) && file.exists(input)) { + returnedDoc <- xml2::read_xml(input) + } else if (is.raw(input)) { + returnedDoc <- xml2::read_xml(input) + raw <- TRUE + } response <- xml2::xml_name(returnedDoc) if (response == "GetObservationResponse") { diff --git a/R/readNGWMNdata.R b/R/readNGWMNdata.R index a1382729..5c283e81 100644 --- a/R/readNGWMNdata.R +++ b/R/readNGWMNdata.R @@ -165,13 +165,18 @@ readNGWMNsites <- function(siteNumbers) { } retrieveObservation <- function(featureID, asDateTime, attrs, tz) { - url <- drURL( - base.name = "NGWMN", access = pkg.env$access, request = "GetObservation", - service = "SOS", version = "2.0.0", observedProperty = "urn:ogc:def:property:OGC:GroundWaterLevel", - responseFormat = "text/xml", featureOfInterest = paste("VW_GWDP_GEOSERVER", featureID, sep = ".") - ) - - returnData <- importNGWMN(url, asDateTime = asDateTime, tz = tz) + + baseURL <- httr2::request(pkg.env[["NGWMN"]]) + baseURL <- httr2::req_url_query(baseURL, + request = "GetObservation", + service = "SOS", + version = "2.0.0", + observedProperty = "urn:ogc:def:property:OGC:GroundWaterLevel", + responseFormat = "text/xml", + featureOfInterest = paste("VW_GWDP_GEOSERVER", featureID, sep = ".")) + + + returnData <- importNGWMN(baseURL, asDateTime = asDateTime, tz = tz) if (nrow(returnData) == 0) { # need to add NA attributes, so they aren't messed up when stored as DFs attr(returnData, "gml:identifier") <- NA @@ -195,23 +200,27 @@ retrieveObservation <- function(featureID, asDateTime, attrs, tz) { # retrieve feature of interest # could allow pass through srsName - needs to be worked in higher-up in dots retrieveFeatureOfInterest <- function(..., asDateTime, srsName = "urn:ogc:def:crs:EPSG::4269") { - dots <- convertLists(...) - - values <- sapply(dots, function(x) as.character(paste0(eval(x), collapse = ","))) - values <- sapply(values, function(x) utils::URLencode(x, reserved = TRUE)) - - url <- drURL( - base.name = "NGWMN", access = pkg.env$access, request = "GetFeatureOfInterest", - service = "SOS", version = "2.0.0", responseFormat = "text/xml" - ) - + values <- convertLists(...) + + baseURL <- httr2::request(pkg.env[["NGWMN"]]) + baseURL <- httr2::req_url_query(baseURL, + request = "GetFeatureOfInterest", + service = "SOS", + version = "2.0.0", + responseFormat = "text/xml") + if ("featureID" %in% names(values)) { - url <- appendDrURL(url, featureOfInterest = paste("VW_GWDP_GEOSERVER", - values[["featureID"]], - sep = "." - )) + + features <- paste("VW_GWDP_GEOSERVER", + values[["featureID"]], + sep = ".") + + baseURL <- httr2::req_url_query(baseURL, + featureOfInterest = features, + .multi = "comma") + } else if ("bbox" %in% names(values)) { - url <- appendDrURL(url, + baseURL <- httr2::req_url_query(baseURL, bbox = paste(values[["bbox"]], collapse = ","), srsName = srsName ) @@ -219,8 +228,8 @@ retrieveFeatureOfInterest <- function(..., asDateTime, srsName = "urn:ogc:def:cr stop("Geographical filter not specified. Please use siteNumbers or bbox") } - siteDF <- importNGWMN(url, asDateTime, tz = "") - attr(siteDF, "url") <- url + siteDF <- importNGWMN(baseURL, asDateTime, tz = "") + attr(siteDF, "url") <- baseURL$url attr(siteDF, "queryTime") <- Sys.time() return(siteDF) } diff --git a/tests/testthat/tests_general.R b/tests/testthat/tests_general.R index b331eefe..0866d1d4 100644 --- a/tests/testthat/tests_general.R +++ b/tests/testthat/tests_general.R @@ -424,45 +424,6 @@ test_that("readWQPdots working", { }) -context("getWebServiceData") -# test_that("long urls use POST", { -# testthat::skip_on_cran() -# baseURL <- dataRetrieval:::drURL("Result") -# url <- paste0(baseURL, -# rep("reallylongurl", 200), -# collapse = "" -# ) -# with_mock( -# RETRY = function(method, ...) { -# return(method == "POST") -# }, -# status_code = function(resp) 200, -# headers = function(resp) list(`content-type` = "logical"), -# content = function(resp, encoding) resp, -# expect_true(getWebServiceData(url)), -# .env = "httr" -# ) -# }) -# -# test_that("ngwmn urls don't use post", { -# testthat::skip_on_cran() -# baseURL <- dataRetrieval:::drURL("NGWMN") -# url <- paste0(baseURL, -# rep("urlwithngwmn", 200), -# collapse = "" -# ) -# with_mock( -# RETRY = function(method, ...) { -# return(method == "POST") -# }, -# status_code = function(resp) 200, -# headers = function(resp) list(`content-type` = "logical"), -# content = function(resp, encoding) resp, -# expect_false(getWebServiceData(url)), -# .env = "httr" -# ) -# }) - test_that("internal functions", { # get empty_col type From 111feb53062d5cab30b8fa72a037a54f5943e1fc Mon Sep 17 00:00:00 2001 From: Laura A DeCicco Date: Tue, 5 Nov 2024 09:06:31 -0600 Subject: [PATCH 18/30] Dropping problimatic example (data source keeps changing) --- DESCRIPTION | 2 +- R/findNLDI.R | 13 +++++-------- man/findNLDI.Rd | 3 --- 3 files changed, 6 insertions(+), 12 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 6362d9ea..ad630061 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: dataRetrieval Type: Package Title: Retrieval Functions for USGS and EPA Hydrology and Water Quality Data -Version: 2.7.17.1 +Version: 2.7.17.9000 Authors@R: c( person("Laura", "DeCicco", role = c("aut","cre"), email = "ldecicco@usgs.gov", diff --git a/R/findNLDI.R b/R/findNLDI.R index 2438f40f..86e60396 100644 --- a/R/findNLDI.R +++ b/R/findNLDI.R @@ -74,10 +74,10 @@ get_nldi_sources <- function(url = pkg.env$nldi_base) { #' @examplesIf is_dataRetrieval_user() #' \donttest{ #' base <- "https://api.water.usgs.gov/nldi/linked-data/" -#' get_nldi(paste0(base, "comid/101"), type = "feature", use_sf = FALSE) -#' get_nldi(paste0(base, "comid/101"), type = "feature", use_sf = TRUE) -#' get_nldi(url = paste0(base, "nwissite/USGS-11120000"), type = "feature", use_sf = TRUE) -#' get_nldi(paste0(base, "nwissite/USGS-11120000"), type = "feature", use_sf = TRUE) +#' dataRetrieval:::get_nldi(paste0(base, "comid/101"), type = "feature", use_sf = FALSE) +#' dataRetrieval:::get_nldi(paste0(base, "comid/101"), type = "feature", use_sf = TRUE) +#' dataRetrieval:::get_nldi(url = paste0(base, "nwissite/USGS-11120000"), type = "feature", use_sf = TRUE) +#' dataRetrieval:::get_nldi(paste0(base, "nwissite/USGS-11120000"), type = "feature", use_sf = TRUE) #' } get_nldi <- function(url, type = "", use_sf = FALSE, warn = TRUE) { @@ -208,7 +208,7 @@ clean_nwis_ids <- function(tmp) { #' @noRd #' @examplesIf is_dataRetrieval_user() #' \donttest{ -#' valid_ask(all = get_nldi_sources(), "nwis") +#' dataRetrieval:::valid_ask(all = get_nldi_sources(), "nwis") #' } valid_ask <- function(all, type) { # those where the requested pattern is included in a nldi_source ... @@ -285,9 +285,6 @@ valid_ask <- function(all, type) { #' ## GENERAL ORIGIN: COMID #' findNLDI(origin = list("comid" = 101)) #' -#' ## GENERAL ORIGIN: WaDE -#' findNLDI(origin = list("wade" = "CA_45206")) -#' #' # Navigation (flowlines will be returned if find is unspecified) #' # UPPER MAINSTEM of USGS-11120000 #' findNLDI(nwis = "11120000", nav = "UM") diff --git a/man/findNLDI.Rd b/man/findNLDI.Rd index 3925c631..9944c1e8 100644 --- a/man/findNLDI.Rd +++ b/man/findNLDI.Rd @@ -87,9 +87,6 @@ findNLDI(location = c(-115, 40)) ## GENERAL ORIGIN: COMID findNLDI(origin = list("comid" = 101)) -## GENERAL ORIGIN: WaDE -findNLDI(origin = list("wade" = "CA_45206")) - # Navigation (flowlines will be returned if find is unspecified) # UPPER MAINSTEM of USGS-11120000 findNLDI(nwis = "11120000", nav = "UM") From d289745c7aed80966fa28b8281230e05636fb5a2 Mon Sep 17 00:00:00 2001 From: Laura A DeCicco Date: Tue, 5 Nov 2024 11:10:09 -0600 Subject: [PATCH 19/30] adding count=no to legacy --- R/constructNWISURL.R | 2 ++ R/getWebServiceData.R | 2 +- R/readWQPdots.R | 4 ++++ 3 files changed, 7 insertions(+), 1 deletion(-) diff --git a/R/constructNWISURL.R b/R/constructNWISURL.R index 44f51fa6..e70f449c 100644 --- a/R/constructNWISURL.R +++ b/R/constructNWISURL.R @@ -311,6 +311,8 @@ constructWQPURL <- function(siteNumbers, siteNumbers <- paste(siteNumbers, collapse = ";") baseURL <- httr2::req_url_query(baseURL, siteid = siteNumbers) + baseURL <- httr2::req_url_query(baseURL, + count = "no") } else { baseURL <- httr2::request(pkg.env[["ResultWQX3"]]) baseURL <- httr2::req_url_query(baseURL, diff --git a/R/getWebServiceData.R b/R/getWebServiceData.R index abfb1af9..6612f03f 100644 --- a/R/getWebServiceData.R +++ b/R/getWebServiceData.R @@ -32,7 +32,7 @@ getWebServiceData <- function(obs_url, ...) { obs_url <- httr2::req_headers(obs_url, `Accept-Encoding` = c("compress", "gzip")) - print(obs_url) #when happy with httr2, maybe only print url + message("GET:", obs_url$url) returnedList <- httr2::req_perform(obs_url) good <- check_non_200s(returnedList) diff --git a/R/readWQPdots.R b/R/readWQPdots.R index 253cd609..35a67c90 100644 --- a/R/readWQPdots.R +++ b/R/readWQPdots.R @@ -86,6 +86,10 @@ readWQPdots <- function(..., legacy = TRUE) { values["mimeType"] <- "csv" } + if(legacy & !("count" %in% names(values))){ + values["count"] <- "no" + } + return_list <- list() return_list["values"] <- list(values) return_list["service"] <- service From 7ad1ed56d582b62d1298fb41693bb87485594ae6 Mon Sep 17 00:00:00 2001 From: Laura A DeCicco Date: Tue, 5 Nov 2024 11:12:03 -0600 Subject: [PATCH 20/30] updating docker file --- docker/Dockerfile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docker/Dockerfile b/docker/Dockerfile index 53f5144e..c727cda3 100644 --- a/docker/Dockerfile +++ b/docker/Dockerfile @@ -14,7 +14,7 @@ RUN apt-get update -qq && apt-get -y --no-install-recommends install \ r-cran-jsonlite \ r-cran-readr \ r-cran-xml2 \ - r-cran-httr \ + r-cran-httr2 \ r-cran-rsconnect \ r-cran-connectapi \ r-cran-covr \ From 20fa9e700a832127ff861a55931c7149eab4c2fa Mon Sep 17 00:00:00 2001 From: Laura A DeCicco Date: Tue, 5 Nov 2024 11:24:49 -0600 Subject: [PATCH 21/30] run check on develop --- .github/workflows/R-CMD-check.yaml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index e164d0a6..d91c244f 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -2,9 +2,9 @@ # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help on: push: - branches: [main] + branches: [main, develop] pull_request: - branches: [main] + branches: [main, develop] name: R-CMD-check From 8f93afeecd771ef53f01f0d808142fe584bef0c1 Mon Sep 17 00:00:00 2001 From: Laura A DeCicco Date: Tue, 5 Nov 2024 12:03:49 -0600 Subject: [PATCH 22/30] Fix test due to my last minute addition of count=no to legacy WQP --- tests/testthat/tests_general.R | 29 ++---------------------- tests/testthat/tests_userFriendly_fxns.R | 2 +- 2 files changed, 3 insertions(+), 28 deletions(-) diff --git a/tests/testthat/tests_general.R b/tests/testthat/tests_general.R index 0866d1d4..d7d7c326 100644 --- a/tests/testthat/tests_general.R +++ b/tests/testthat/tests_general.R @@ -398,7 +398,7 @@ test_that("readWQPdots working", { # NWIS names (stateCd) converted to WQP expected names (statecode) formArgs <- dataRetrieval:::readWQPdots(stateCd = "OH", parameterCd = "00665") - expect_true(length(formArgs$values) == 3) + expect_true(length(formArgs$values) == 4) expect_true("statecode" %in% names(formArgs$values)) expect_false("stateCd" %in% names(formArgs$values)) @@ -557,18 +557,6 @@ test_that("profiles", { "OrganizationFormalName" ) %in% names(samp_activity))) - # # Data profile: "Sampling Activity Metrics" - # act_metrics <- readWQPdata( - # statecode = "WI", - # countycode = "Dane", - # service = "ActivityMetric" - # ) - # - # expect_true(all(c( - # "OrganizationIdentifier", - # "OrganizationFormalName" - # ) %in% names(act_metrics))) - # Data profile: "Result Detection Quantitation Limit Data" dl_data <- readWQPdata( siteid = "USGS-04024315", @@ -634,7 +622,7 @@ test_that("readWQPsummary", { # nolint start: line_length_linter expect_equal( attr(site1, "url"), - "https://www.waterqualitydata.us/data/summary/monitoringLocation/search?siteid=USGS-07144100&summaryYears=5&mimeType=csv&dataProfile=periodOfRecord" + "https://www.waterqualitydata.us/data/summary/monitoringLocation/search?siteid=USGS-07144100&summaryYears=5&mimeType=csv&count=no&dataProfile=periodOfRecord" ) # nolint end }) @@ -642,19 +630,6 @@ test_that("readWQPsummary", { test_that("importWQP convertType", { testthat::skip_on_cran() - # rawSampleURL_NoZip <- constructWQPURL("USGS-01594440", "01075", "", "") - # rawSampleURL_NoZip_char <- importWQP(rawSampleURL_NoZip, convertType = FALSE) - # expect_is(rawSampleURL_NoZip_char$Result_Measure, "character") - # - # Put back in when services get more robust. - # phos <- readWQPdata(statecode = "WI", countycode = "Dane", - # characteristicName = "Phosphorus", - # startDateLo = "2022-06-01", - # startDateHi = "2022-09-01", - # convertType = FALSE, - # service = "ResultWQX") - # expect_is(phos$Result_Measure, "character") - SC <- readWQPqw(siteNumbers = "USGS-05288705", parameterCd = "00300", convertType = FALSE, legacy = TRUE) expect_is(SC$ResultMeasureValue, "character") diff --git a/tests/testthat/tests_userFriendly_fxns.R b/tests/testthat/tests_userFriendly_fxns.R index 132454e9..d9259bf1 100644 --- a/tests/testthat/tests_userFriendly_fxns.R +++ b/tests/testthat/tests_userFriendly_fxns.R @@ -97,7 +97,7 @@ test_that("peak, rating curves, surface-water measurements", { expect_equal(nrow(whatNWISdata(siteNumber = "10312000", parameterCd = "50286")), 0) expect_equal(ncol(whatNWISdata(siteNumber = "10312000", parameterCd = "50286")), 24) - url <- "https://waterservices.usgs.gov/nwis/site/?format=rdb&seriesCatalogOutput=true&sites=05114000" + url <- httr2::request("https://waterservices.usgs.gov/nwis/site/?format=rdb&seriesCatalogOutput=true&sites=05114000") x <- importRDB1(url) siteID <- "263819081585801" From 8ee4a7aaa99d13a1b0a1c4ba7fb5cd4ab01a0ee7 Mon Sep 17 00:00:00 2001 From: Laura A DeCicco Date: Tue, 5 Nov 2024 12:36:39 -0600 Subject: [PATCH 23/30] change example --- R/importNGWMN_wml2.R | 18 +++++++++--------- man/importWaterML2.Rd | 18 +++++++++--------- 2 files changed, 18 insertions(+), 18 deletions(-) diff --git a/R/importNGWMN_wml2.R b/R/importNGWMN_wml2.R index 22eafccc..28e2076e 100644 --- a/R/importNGWMN_wml2.R +++ b/R/importNGWMN_wml2.R @@ -134,16 +134,16 @@ importNGWMN <- function(input, asDateTime = FALSE, tz = "UTC") { #' @export #' @examplesIf is_dataRetrieval_user() #' \donttest{ -#' baseURL <- "https://waterservices.usgs.gov/nwis/dv/?format=waterml,2.0" -#' URL <- paste(baseURL, "sites=01646500", -#' "startDT=2014-09-01", -#' "endDT=2014-09-08", -#' "statCd=00003", -#' "parameterCd=00060", -#' sep = "&" -#' ) +#' baseURL <- httr2::request("https://waterservices.usgs.gov/nwis/dv") +#' baseURL <- httr2::req_url_query(baseURL, +#' format = "waterml,2.0", +#' sites = "01646500", +#' startDT = "2014-09-01", +#' endDT = "2014-09-08", +#' statCd = "00003", +#' parameterCd = "00060" ) #' -#' timesereies <- importWaterML2(URL, asDateTime = TRUE, tz = "UTC") +#' timesereies <- importWaterML2(baseURL, asDateTime = TRUE, tz = "UTC") #' } importWaterML2 <- function(input, asDateTime = FALSE, tz = "UTC") { returnedDoc <- check_if_xml(input) diff --git a/man/importWaterML2.Rd b/man/importWaterML2.Rd index 44f950bb..d7ce2939 100644 --- a/man/importWaterML2.Rd +++ b/man/importWaterML2.Rd @@ -24,16 +24,16 @@ Anything defined as a default, is returned as an attribute of that data frame. \examples{ \dontshow{if (is_dataRetrieval_user()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} \donttest{ -baseURL <- "https://waterservices.usgs.gov/nwis/dv/?format=waterml,2.0" -URL <- paste(baseURL, "sites=01646500", - "startDT=2014-09-01", - "endDT=2014-09-08", - "statCd=00003", - "parameterCd=00060", - sep = "&" -) +baseURL <- httr2::request("https://waterservices.usgs.gov/nwis/dv") +baseURL <- httr2::req_url_query(baseURL, + format = "waterml,2.0", + sites = "01646500", + startDT = "2014-09-01", + endDT = "2014-09-08", + statCd = "00003", + parameterCd = "00060" ) -timesereies <- importWaterML2(URL, asDateTime = TRUE, tz = "UTC") +timesereies <- importWaterML2(baseURL, asDateTime = TRUE, tz = "UTC") } \dontshow{\}) # examplesIf} } From 0b60de4f6cf10896a0b7a34fb15b5de3f088b4ae Mon Sep 17 00:00:00 2001 From: Laura A DeCicco Date: Tue, 5 Nov 2024 14:58:43 -0600 Subject: [PATCH 24/30] Another set of multi's --- R/constructNWISURL.R | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/R/constructNWISURL.R b/R/constructNWISURL.R index e70f449c..6b329de7 100644 --- a/R/constructNWISURL.R +++ b/R/constructNWISURL.R @@ -160,7 +160,10 @@ constructNWISURL <- function(siteNumbers, url <- httr2::req_url_query(baseURL, sites = siteNumbers, - statReportType = statReportType) + .multi = "comma") + url <- httr2::req_url_query(url, + statReportType = statReportType, + .multi = "comma") url <- httr2::req_url_query(url, statType = statType, .multi = "comma") url <- httr2::req_url_query(url, parameterCd = parameterCd, @@ -420,7 +423,9 @@ constructUseURL <- function(years, stateCd, countyCd, categories) { baseURL <- httr2::req_url_query(baseURL, wu_year = years, .multi = "comma") - baseURL <- httr2::req_url_query(baseURL, wu_category = categories) + baseURL <- httr2::req_url_query(baseURL, + wu_category = categories, + .multi = "comma") return(baseURL) } \ No newline at end of file From 6146ebba92858383ba33c1fd6b49bee0bb15d917 Mon Sep 17 00:00:00 2001 From: Laura A DeCicco Date: Tue, 5 Nov 2024 15:46:03 -0600 Subject: [PATCH 25/30] wqp_check_status example --- R/readWQPdata.R | 3 ++- man/wqp_check_status.Rd | 3 ++- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/R/readWQPdata.R b/R/readWQPdata.R index 9eaf118c..b6a12347 100644 --- a/R/readWQPdata.R +++ b/R/readWQPdata.R @@ -319,7 +319,8 @@ create_WQP_attributes <- function(retval, ...){ #' #' @examplesIf is_dataRetrieval_user() #' \donttest{ -#' rawPcode <- readWQPqw("USGS-01594440", "01075", ignore_attributes = TRUE) +#' rawPcode <- readWQPqw("USGS-01594440", "01075", +#' ignore_attributes = TRUE, legacy = FALSE) #' headerInfo <- attr(rawPcode, "headerInfo") #' wqp_request_id <- headerInfo$`wqp-request-id` #' count_info <- wqp_check_status(wqp_request_id) diff --git a/man/wqp_check_status.Rd b/man/wqp_check_status.Rd index 61e7b8f9..f46c172e 100644 --- a/man/wqp_check_status.Rd +++ b/man/wqp_check_status.Rd @@ -23,7 +23,8 @@ function will be attached as an attribute to the data. \examples{ \dontshow{if (is_dataRetrieval_user()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} \donttest{ -rawPcode <- readWQPqw("USGS-01594440", "01075", ignore_attributes = TRUE) +rawPcode <- readWQPqw("USGS-01594440", "01075", + ignore_attributes = TRUE, legacy = FALSE) headerInfo <- attr(rawPcode, "headerInfo") wqp_request_id <- headerInfo$`wqp-request-id` count_info <- wqp_check_status(wqp_request_id) From 722ed47bcdb9a50d6e6f9bfebb245afd4aeede1b Mon Sep 17 00:00:00 2001 From: Laura A DeCicco Date: Mon, 25 Nov 2024 11:11:06 -0600 Subject: [PATCH 26/30] Trying new GH actions to reduce suggest list, and responding to a few of Joe's comments. --- .github/workflows/R-CMD-check.yaml | 3 ++- .github/workflows/pkgdown.yaml | 10 +++++++++- R/getWebServiceData.R | 10 +++++----- R/importNGWMN_wml2.R | 19 ++++++++++++------- R/readNWISpCode.R | 2 +- man/getWebServiceData.Rd | 2 +- man/importNGWMN.Rd | 19 ++++++++++++------- man/readNWISpCode.Rd | 2 +- 8 files changed, 43 insertions(+), 24 deletions(-) diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index d91c244f..fcd9637e 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -44,7 +44,8 @@ jobs: - uses: r-lib/actions/setup-r-dependencies@96b1dc658a45175f93ed5f33fda2b2cebbb12ee8 with: - extra-packages: any::rcmdcheck + extra-packages: | + any::rcmdcheck needs: check - uses: r-lib/actions/check-r-package@3e56ca41aa267855f36891af7a495d24bfaa8373 diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml index 80a8833b..ac6d805e 100644 --- a/.github/workflows/pkgdown.yaml +++ b/.github/workflows/pkgdown.yaml @@ -40,7 +40,15 @@ jobs: - uses: r-lib/actions/setup-r-dependencies@52330cc136b963487918a8867f948ddf954e9e63 with: - extra-packages: any::pkgdown, local::. + extra-packages: | + any::pkgdown + any::rcmdcheck + any::DT + any::data.table + any::dplyr + any::tidyr + any::gridExtra + local::. needs: website - name: Build site diff --git a/R/getWebServiceData.R b/R/getWebServiceData.R index 6612f03f..6bc9cf39 100644 --- a/R/getWebServiceData.R +++ b/R/getWebServiceData.R @@ -7,7 +7,7 @@ #' @param obs_url character containing the url for the retrieval #' @param \dots information to pass to header request #' @export -#' @return raw data from web services +#' @return Returns xml, json, or text depending on the requested data. #' @examplesIf is_dataRetrieval_user() #' siteNumber <- "02177000" #' startDate <- "2012-09-01" @@ -39,8 +39,8 @@ getWebServiceData <- function(obs_url, ...) { return_readLines <- c("text/html", "text/html; charset=UTF-8") - return_raw <- c("application/zip", - "application/zip;charset=UTF-8") + # return_raw <- c("application/zip", + # "application/zip;charset=UTF-8") return_content <- c("text/tab-separated-values;charset=UTF-8", "text/csv;charset=UTF-8", @@ -76,8 +76,8 @@ getWebServiceData <- function(obs_url, ...) { } } - } else if (headerInfo$`content-type` %in% return_raw) { - returnedDoc <- httr2::resp_body_raw(returnedList) + # } else if (headerInfo$`content-type` %in% return_raw) { + # returnedDoc <- httr2::resp_body_raw(returnedList) } else if (headerInfo$`content-type` %in% return_readLines) { returnedList <- httr2::resp_body_string(returnedList) txt <- readLines(returnedList$content) diff --git a/R/importNGWMN_wml2.R b/R/importNGWMN_wml2.R index 28e2076e..b2a77150 100644 --- a/R/importNGWMN_wml2.R +++ b/R/importNGWMN_wml2.R @@ -15,13 +15,18 @@ #' @export #' @examplesIf is_dataRetrieval_user() #' \donttest{ -#' obs_url <- paste("https://cida.usgs.gov/ngwmn_cache/sos?request=GetObservation", -#' "service=SOS", "version=2.0.0", -#' "observedProperty=urn:ogc:def:property:OGC:GroundWaterLevel", -#' "responseFormat=text/xml", -#' "featureOfInterest=VW_GWDP_GEOSERVER.USGS.403836085374401", -#' sep = "&" -#' ) +#' +#' params <- list(request = "GetObservation", +#' service = "SOS", +#' version = "2.0.0", +#' observedProperty = "urn:ogc:def:property:OGC:GroundWaterLevel", +#' responseFormat = "text/xml", +#' featureOfInterest = "VW_GWDP_GEOSERVER.USGS.403836085374401") +#' +#' obs_url <- httr2::request("https://cida.usgs.gov") |> +#' httr2::req_url_path_append("ngwmn_cache") |> +#' httr2::req_url_path_append("sos") |> +#' httr2::req_url_query(!!!params) #' #' #data_returned <- importNGWMN(obs_url) #' } diff --git a/R/readNWISpCode.R b/R/readNWISpCode.R index 3723b8f0..1bb77bd7 100644 --- a/R/readNWISpCode.R +++ b/R/readNWISpCode.R @@ -1,6 +1,6 @@ #' USGS Parameter Data Retrieval #' -#' Imports data from NWIS about meaured parameter based on user-supplied parameter code or codes. +#' Imports data from NWIS about measured parameter based on user-supplied parameter code or codes. #' This function gets the data from here: \url{https://nwis.waterdata.usgs.gov/nwis/pmcodes} #' #' @param parameterCd character of USGS parameter codes (or multiple parameter codes). These are 5 digit number codes, diff --git a/man/getWebServiceData.Rd b/man/getWebServiceData.Rd index 4ebf8634..5ad3fa83 100644 --- a/man/getWebServiceData.Rd +++ b/man/getWebServiceData.Rd @@ -12,7 +12,7 @@ getWebServiceData(obs_url, ...) \item{\dots}{information to pass to header request} } \value{ -raw data from web services +Returns xml, json, or text depending on the requested data. } \description{ This function accepts a url parameter, and returns the raw data. diff --git a/man/importNGWMN.Rd b/man/importNGWMN.Rd index 4e0a6ab1..d2d436b2 100644 --- a/man/importNGWMN.Rd +++ b/man/importNGWMN.Rd @@ -28,13 +28,18 @@ but the general functionality is correct. \examples{ \dontshow{if (is_dataRetrieval_user()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} \donttest{ -obs_url <- paste("https://cida.usgs.gov/ngwmn_cache/sos?request=GetObservation", - "service=SOS", "version=2.0.0", - "observedProperty=urn:ogc:def:property:OGC:GroundWaterLevel", - "responseFormat=text/xml", - "featureOfInterest=VW_GWDP_GEOSERVER.USGS.403836085374401", - sep = "&" -) + +params <- list(request = "GetObservation", + service = "SOS", + version = "2.0.0", + observedProperty = "urn:ogc:def:property:OGC:GroundWaterLevel", + responseFormat = "text/xml", + featureOfInterest = "VW_GWDP_GEOSERVER.USGS.403836085374401") + +obs_url <- httr2::request("https://cida.usgs.gov") |> + httr2::req_url_path_append("ngwmn_cache") |> + httr2::req_url_path_append("sos") |> + httr2::req_url_query(!!!params) #data_returned <- importNGWMN(obs_url) } diff --git a/man/readNWISpCode.Rd b/man/readNWISpCode.Rd index 20fb48d1..8e608816 100644 --- a/man/readNWISpCode.Rd +++ b/man/readNWISpCode.Rd @@ -24,7 +24,7 @@ parameterData data frame with the following information: } } \description{ -Imports data from NWIS about meaured parameter based on user-supplied parameter code or codes. +Imports data from NWIS about measured parameter based on user-supplied parameter code or codes. This function gets the data from here: \url{https://nwis.waterdata.usgs.gov/nwis/pmcodes} } \examples{ From 0b308217647d3f361a9d9f8c663118fdaa4b4bf8 Mon Sep 17 00:00:00 2001 From: Laura A DeCicco Date: Mon, 25 Nov 2024 11:13:04 -0600 Subject: [PATCH 27/30] =?UTF-8?q?Shame,=20shame,=20shame!=20=F0=9F=98=94?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- R/constructNWISURL.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/constructNWISURL.R b/R/constructNWISURL.R index 6b329de7..2d246167 100644 --- a/R/constructNWISURL.R +++ b/R/constructNWISURL.R @@ -182,7 +182,7 @@ constructNWISURL <- function(siteNumbers, gwlevels = { url <- httr2::req_url_query(baseURL, - site_no = siteNumbers,.multi = "comma") + site_no = siteNumbers, .multi = "comma") url <- httr2::req_url_query(url,format = "rdb") if (nzchar(startDate)) { url <- httr2::req_url_query(url, begin_date = startDate) From 1704e18ad58b7ecc506921e20f795a0ee8785966 Mon Sep 17 00:00:00 2001 From: Laura A DeCicco Date: Mon, 25 Nov 2024 11:20:33 -0600 Subject: [PATCH 28/30] Meant to include this so we can test if the GH actions work (building the site and extra articles) --- DESCRIPTION | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index ad630061..ad25871a 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -37,7 +37,7 @@ Copyright: This software is in the public domain because it contains materials that originally came from the United States Geological Survey, an agency of the United States Department of Interior. Depends: - R (>= 3.5.0) + R (>= 4.1.0) Imports: curl, lubridate (>= 1.5.0), @@ -50,11 +50,6 @@ Imports: Suggests: covr, dplyr, - ggplot2, - tidyr, - data.table, - DT, - gridExtra, knitr, rmarkdown, sf, From 29ecfcb9e0e9f91836ccbf31904ea0ec87a9ca37 Mon Sep 17 00:00:00 2001 From: Laura A DeCicco Date: Mon, 25 Nov 2024 11:54:53 -0600 Subject: [PATCH 29/30] More updates thanks to Joe's review --- .github/workflows/R-CMD-check.yaml | 2 +- R/findNLDI.R | 14 -------------- R/importNGWMN_wml2.R | 2 +- R/whatWQPdata.R | 12 +++++------- R/whatWQPsites.R | 12 +++++++----- man/importWaterML2.Rd | 2 +- man/readWQPsummary.Rd | 1 + man/whatWQPdata.Rd | 4 +++- man/wqpSpecials.Rd | 14 +++++++------- 9 files changed, 26 insertions(+), 37 deletions(-) diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index fcd9637e..b569b067 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -36,7 +36,7 @@ jobs: - uses: r-lib/actions/setup-pandoc@6012817847b5f064d0882d67a7b5e2ca6639afb2 - - uses: r-lib/actions/setup-r@15cf1013badbaf6d25f100593ad5d7d75e65d64b + - uses: r-lib/actions/setup-r@473c68190595b311a74f208fba61a8d8c0d4c247 with: r-version: ${{ matrix.config.r }} http-user-agent: ${{ matrix.config.http-user-agent }} diff --git a/R/findNLDI.R b/R/findNLDI.R index 86e60396..b2b9f5c6 100644 --- a/R/findNLDI.R +++ b/R/findNLDI.R @@ -71,15 +71,6 @@ get_nldi_sources <- function(url = pkg.env$nldi_base) { #' @keywords nldi internal #' @noRd #' @return a data.frame -#' @examplesIf is_dataRetrieval_user() -#' \donttest{ -#' base <- "https://api.water.usgs.gov/nldi/linked-data/" -#' dataRetrieval:::get_nldi(paste0(base, "comid/101"), type = "feature", use_sf = FALSE) -#' dataRetrieval:::get_nldi(paste0(base, "comid/101"), type = "feature", use_sf = TRUE) -#' dataRetrieval:::get_nldi(url = paste0(base, "nwissite/USGS-11120000"), type = "feature", use_sf = TRUE) -#' dataRetrieval:::get_nldi(paste0(base, "nwissite/USGS-11120000"), type = "feature", use_sf = TRUE) -#' } - get_nldi <- function(url, type = "", use_sf = FALSE, warn = TRUE) { # Query res <- httr2::request(url) @@ -187,7 +178,6 @@ get_nldi <- function(url, type = "", use_sf = FALSE, warn = TRUE) { #' @return the input object with potentially modified identifiers #' @keywords nldi internal #' @noRd - clean_nwis_ids <- function(tmp) { # If data.frame, and of type NWIS, then strip "USGS-" from identifiers if (is.data.frame(tmp)) { @@ -206,10 +196,6 @@ clean_nwis_ids <- function(tmp) { #' @return a list with good and bad entries #' @keywords nldi internal #' @noRd -#' @examplesIf is_dataRetrieval_user() -#' \donttest{ -#' dataRetrieval:::valid_ask(all = get_nldi_sources(), "nwis") -#' } valid_ask <- function(all, type) { # those where the requested pattern is included in a nldi_source ... # means we will catch nwis - not just nwissite ... diff --git a/R/importNGWMN_wml2.R b/R/importNGWMN_wml2.R index b2a77150..72d57138 100644 --- a/R/importNGWMN_wml2.R +++ b/R/importNGWMN_wml2.R @@ -148,7 +148,7 @@ importNGWMN <- function(input, asDateTime = FALSE, tz = "UTC") { #' statCd = "00003", #' parameterCd = "00060" ) #' -#' timesereies <- importWaterML2(baseURL, asDateTime = TRUE, tz = "UTC") +#' timeseries <- importWaterML2(baseURL, asDateTime = TRUE, tz = "UTC") #' } importWaterML2 <- function(input, asDateTime = FALSE, tz = "UTC") { returnedDoc <- check_if_xml(input) diff --git a/R/whatWQPdata.R b/R/whatWQPdata.R index b9ed6a9d..bdf68db1 100644 --- a/R/whatWQPdata.R +++ b/R/whatWQPdata.R @@ -1,9 +1,8 @@ #' @name whatWQPsamples #' @rdname wqpSpecials -#' @param convertType logical, defaults to \code{TRUE}. If \code{TRUE}, the -#' function will convert the data to dates, datetimes, -#' numerics based on a standard algorithm. If false, everything is returned as a character. #' @export +#' @return A data frame with information on the sampling activity +#' available from the Water Quality Portal for the query parameters. #' @examples #' \donttest{ #' @@ -75,9 +74,6 @@ whatWQPsamples <- function(..., #' @name whatWQPmetrics #' @rdname wqpSpecials -#' @param convertType logical, defaults to \code{TRUE}. If \code{TRUE}, -#' the function will convert the data to dates, datetimes, -#' numerics based on a standard algorithm. If false, everything is returned as a character. #' @export #' @examples #' \donttest{ @@ -171,7 +167,9 @@ whatWQPmetrics <- function(..., #' will convert the data to dates, datetimes, #' numerics based on a standard algorithm. If false, everything is returned as a character. #' @keywords data import WQP web service -#' @return A data frame based on the Water Quality Portal results. +#' @return A data frame that returns basic data availability such as +#' sites, number of results, and number of sampling activities from the +#' query parameters for the Water Quality Portal. #' #' @export #' @seealso whatWQPsites readWQPsummary readWQPdata diff --git a/R/whatWQPsites.R b/R/whatWQPsites.R index e9b61885..183f088d 100644 --- a/R/whatWQPsites.R +++ b/R/whatWQPsites.R @@ -8,8 +8,6 @@ #' generally faster than the \code{\link{whatWQPdata}} function, but does #' not return information on what data was collected at the site. #' -#' The \code{readWQPsummary} function has -#' #' @param \dots see \url{https://www.waterqualitydata.us/webservices_documentation} #' for a complete list of options. A list of arguments can also be supplied. #' One way to figure out how to construct a WQP query is to go to the "Advanced" @@ -24,11 +22,14 @@ #' mimeType, and providers is optional (these arguments are picked automatically). #' @param legacy Logical. If TRUE, uses legacy WQP services. Default is TRUE. #' Setting legacy = FALSE uses WQX3.0 WQP services, which are in-development, use with caution. +#' @param convertType logical, defaults to \code{TRUE}. If \code{TRUE}, the +#' function will convert the data to dates, datetimes, +#' numerics based on a standard algorithm. If false, everything is returned as a character. #' @keywords data import WQP web service #' @rdname wqpSpecials #' @name whatWQPsites #' @seealso whatWQPdata readWQPsummary -#' @return data frame +#' @return data frame that includes information on site metadata. #' #' @export #' @seealso whatNWISdata @@ -44,7 +45,7 @@ #' siteType = type #' ) #' } -whatWQPsites <- function(..., legacy = TRUE) { +whatWQPsites <- function(..., legacy = TRUE, convertType = TRUE) { values <- readWQPdots(..., legacy = legacy) values <- values[["values"]] @@ -71,7 +72,7 @@ whatWQPsites <- function(..., legacy = TRUE) { !!!values, .multi = "explode") - retval <- importWQP(baseURL) + retval <- importWQP(baseURL, convertType = convertType) if(!is.null(retval)){ attr(retval, "queryTime") <- Sys.time() @@ -104,6 +105,7 @@ whatWQPsites <- function(..., legacy = TRUE) { #' characteristicType = "Nutrient". dataRetrieval users do not need to include #' mimeType, and providers is optional (these arguments are picked automatically). #' @return A data frame from the data returned from the Water Quality Portal +#' about the data available for the query parameters. #' @export #' @seealso whatWQPsites whatWQPdata #' @examplesIf is_dataRetrieval_user() diff --git a/man/importWaterML2.Rd b/man/importWaterML2.Rd index d7ce2939..f553dc4c 100644 --- a/man/importWaterML2.Rd +++ b/man/importWaterML2.Rd @@ -33,7 +33,7 @@ baseURL <- httr2::req_url_query(baseURL, statCd = "00003", parameterCd = "00060" ) -timesereies <- importWaterML2(baseURL, asDateTime = TRUE, tz = "UTC") +timeseries <- importWaterML2(baseURL, asDateTime = TRUE, tz = "UTC") } \dontshow{\}) # examplesIf} } diff --git a/man/readWQPsummary.Rd b/man/readWQPsummary.Rd index 8c986b72..08f28856 100644 --- a/man/readWQPsummary.Rd +++ b/man/readWQPsummary.Rd @@ -22,6 +22,7 @@ mimeType, and providers is optional (these arguments are picked automatically).} } \value{ A data frame from the data returned from the Water Quality Portal +about the data available for the query parameters. } \description{ Returns a list of sites with year-by-year information on what data is available. diff --git a/man/whatWQPdata.Rd b/man/whatWQPdata.Rd index f2f97880..b6fedafd 100644 --- a/man/whatWQPdata.Rd +++ b/man/whatWQPdata.Rd @@ -25,7 +25,9 @@ will convert the data to dates, datetimes, numerics based on a standard algorithm. If false, everything is returned as a character.} } \value{ -A data frame based on the Water Quality Portal results. +A data frame that returns basic data availability such as +sites, number of results, and number of sampling activities from the +query parameters for the Water Quality Portal. } \description{ Returns a list of sites from the Water Quality Portal web service. This function gets diff --git a/man/wqpSpecials.Rd b/man/wqpSpecials.Rd index 7b7dfc5c..fda2a399 100644 --- a/man/wqpSpecials.Rd +++ b/man/wqpSpecials.Rd @@ -10,7 +10,7 @@ whatWQPsamples(..., convertType = TRUE, legacy = TRUE) whatWQPmetrics(..., convertType = TRUE) -whatWQPsites(..., legacy = TRUE) +whatWQPsites(..., legacy = TRUE, convertType = TRUE) } \arguments{ \item{\dots}{see \url{https://www.waterqualitydata.us/webservices_documentation} @@ -26,15 +26,18 @@ in the Query URL. The corresponding argument for dataRetrieval is characteristicType = "Nutrient". dataRetrieval users do not need to include mimeType, and providers is optional (these arguments are picked automatically).} -\item{convertType}{logical, defaults to \code{TRUE}. If \code{TRUE}, -the function will convert the data to dates, datetimes, +\item{convertType}{logical, defaults to \code{TRUE}. If \code{TRUE}, the +function will convert the data to dates, datetimes, numerics based on a standard algorithm. If false, everything is returned as a character.} \item{legacy}{Logical. If TRUE, uses legacy WQP services. Default is TRUE. Setting legacy = FALSE uses WQX3.0 WQP services, which are in-development, use with caution.} } \value{ -data frame +A data frame with information on the sampling activity +available from the Water Quality Portal for the query parameters. + +data frame that includes information on site metadata. } \description{ Returns a list of sites from the Water Quality Portal web service. This function @@ -45,9 +48,6 @@ this function returns the basic metadata on WQP sites. It is generally faster than the \code{\link{whatWQPdata}} function, but does not return information on what data was collected at the site. } -\details{ -The \code{readWQPsummary} function has -} \examples{ \donttest{ From 9ce47765461a0604cc98f39da8c4fba6d26abe96 Mon Sep 17 00:00:00 2001 From: Laura A DeCicco Date: Mon, 25 Nov 2024 12:44:08 -0600 Subject: [PATCH 30/30] Custom .multi for legacy --- R/constructNWISURL.R | 15 ++++++++------- R/readWQPdata.R | 4 ++-- R/whatWQPdata.R | 12 ++++++------ R/whatWQPsites.R | 8 ++++---- 4 files changed, 20 insertions(+), 19 deletions(-) diff --git a/R/constructNWISURL.R b/R/constructNWISURL.R index 2d246167..90daba80 100644 --- a/R/constructNWISURL.R +++ b/R/constructNWISURL.R @@ -311,9 +311,9 @@ constructWQPURL <- function(siteNumbers, if(legacy){ baseURL <- httr2::request(pkg.env[["Result"]]) - siteNumbers <- paste(siteNumbers, collapse = ";") baseURL <- httr2::req_url_query(baseURL, - siteid = siteNumbers) + siteid = siteNumbers, + .multi = function(x) paste0(x, collapse = ";")) baseURL <- httr2::req_url_query(baseURL, count = "no") } else { @@ -324,13 +324,14 @@ constructWQPURL <- function(siteNumbers, } if(legacy & !allPCode){ - if (multiplePcodes) { - parameterCd <- paste(parameterCd, collapse = ";") - } if(pCodeLogic){ - baseURL <- httr2::req_url_query(baseURL, pCode = parameterCd) + baseURL <- httr2::req_url_query(baseURL, + pCode = parameterCd, + .multi = function(x) paste0(x, collapse = ";")) } else { - baseURL <- httr2::req_url_query(baseURL, characteristicName = parameterCd) + baseURL <- httr2::req_url_query(baseURL, + characteristicName = parameterCd, + .multi = function(x) paste0(x, collapse = ";")) } } else if(!legacy & !allPCode){ diff --git a/R/readWQPdata.R b/R/readWQPdata.R index b6a12347..85611804 100644 --- a/R/readWQPdata.R +++ b/R/readWQPdata.R @@ -240,9 +240,9 @@ readWQPdata <- function(..., if("siteid" %in% names(values)){ if(length(values[["siteid"]]) > 1){ sites <- values[["siteid"]] - sites <- paste0(sites, collapse = ";") baseURL <- httr2::req_url_query(baseURL, - siteid = sites) + siteid = sites, + .multi = function(x) paste0(x, collapse = ";")) values <- values[names(values) != "siteid"] } } diff --git a/R/whatWQPdata.R b/R/whatWQPdata.R index bdf68db1..7eb7c598 100644 --- a/R/whatWQPdata.R +++ b/R/whatWQPdata.R @@ -43,9 +43,9 @@ whatWQPsamples <- function(..., if("siteid" %in% names(values)){ if(length(values[["siteid"]]) > 1){ sites <- values[["siteid"]] - sites <- paste0(sites, collapse = ";") baseURL <- httr2::req_url_query(baseURL, - siteid = sites) + siteid = sites, + .multi = function(x) paste0(x, collapse = ";")) values <- values[names(values) != "siteid"] } } @@ -103,9 +103,9 @@ whatWQPmetrics <- function(..., if("siteid" %in% names(values)){ if(length(values[["siteid"]]) > 1){ sites <- values[["siteid"]] - sites <- paste0(sites, collapse = ";") baseURL <- httr2::req_url_query(baseURL, - siteid = sites) + siteid = sites, + .multi = function(x) paste0(x, collapse = ";")) values <- values[names(values) != "siteid"] } } @@ -203,9 +203,9 @@ whatWQPdata <- function(..., if("siteid" %in% names(values)){ if(length(values[["siteid"]]) > 1){ sites <- values[["siteid"]] - sites <- paste0(sites, collapse = ";") baseURL <- httr2::req_url_query(baseURL, - siteid = sites) + siteid = sites, + .multi = function(x) paste0(x, collapse = ";")) values <- values[names(values) != "siteid"] } } diff --git a/R/whatWQPsites.R b/R/whatWQPsites.R index 183f088d..79ffccd5 100644 --- a/R/whatWQPsites.R +++ b/R/whatWQPsites.R @@ -59,9 +59,9 @@ whatWQPsites <- function(..., legacy = TRUE, convertType = TRUE) { if("siteid" %in% names(values)){ if(length(values[["siteid"]]) > 1){ sites <- values[["siteid"]] - sites <- paste0(sites, collapse = ";") baseURL <- httr2::req_url_query(baseURL, - siteid = sites) + siteid = sites, + .multi = function(x) paste0(x, collapse = ";")) values <- values[names(values) != "siteid"] } } @@ -162,9 +162,9 @@ readWQPsummary <- function(...) { if(length(values[["siteid"]]) > 1){ sites <- values[["siteid"]] - sites <- paste0(sites, collapse = ";") baseURL <- httr2::req_url_query(baseURL, - siteid = sites) + siteid = sites, + .multi = function(x) paste0(x, collapse = ";")) values <- values[names(values) != "siteid"] }