Merge pull request #843 from ldecicco-USGS/commas

Commas

Author: ldecicco-USGS

R/construct_api_requests.R

@@ -45,31 +45,41 @@ construct_api_requests <- function(service,
 
   POST <- FALSE
 
-  single_params <- c("datetime", "last_modified", "begin", "end", "time", "limit")
+  single_params <- c("datetime", "last_modified", 
+                     "begin", "end", "time", "limit",
+                     "begin_utc", "end_utc")
+  comma_params <- c("monitoring_location_id", "parameter_code", 
+                    "statistic_id", "time_series_id",
+                    "computation_period_identifier",
+                    "computation_identifier")
+  
+  if(service %in% c("monitoring-locations", #"parameter-codes", 
+                    "time-series-metadata")){
+    comma_params <- c(comma_params, "id")
+  }
 
   full_list <- list(...)
 
   if(all(is.na(full_list)) & all(is.na(bbox))){
     warning("No filtering arguments specified.")
   }
-  
-  # GET list refers to arguments that will go in the URL no matter what (not POST)
-  get_list <- full_list[names(full_list) %in% single_params]
+  # Figure out if the GET request will be > 2048 characters
+  comma_params_filtered <- Filter(Negate(anyNA), full_list[comma_params])
 
-  get_list[["skipGeometry"]] <- skipGeometry
-  
-  #POST list are the arguments that need to be in the POST body
-  post_list <- full_list[!names(full_list) %in% single_params]
-  
-  post_params <- explode_post(post_list)
+  force_post <- nchar(paste0(unlist(comma_params_filtered), collapse = ",")) > 2048
 
-  if(length(post_params) > 0){
-    POST = TRUE
+  if(force_post){
+    get_list <- full_list[names(full_list) %in% c(single_params)]
+  } else {
+    # GET list refers to arguments that will go in the URL no matter what (not POST)
+    get_list <- full_list[names(full_list) %in% c(single_params, comma_params)]    
   }
+
+  get_list[["skipGeometry"]] <- skipGeometry
 
   get_list <- get_list[!is.na(get_list)]
 
-  time_periods <- c("last_modified", "datetime", "time", "begin", "end")
+  time_periods <- c("last_modified", "datetime", "time", "begin", "end", "begin_utc", "end_utc")
   if(any(time_periods %in% names(get_list))){
 
     for(i in time_periods[time_periods %in% names(get_list)]){
@@ -85,7 +95,7 @@ construct_api_requests <- function(service,
   format_type <- ifelse(isTRUE(no_paging), "csv", "json")
 
   baseURL <- setup_api(service, format = format_type)
-  baseURL <- explode_query(baseURL, POST = FALSE, get_list)
+  baseURL <- explode_query(baseURL, POST = FALSE, get_list, multi = "comma")
 
   if(all(!is.na(bbox))){
     baseURL <- httr2::req_url_query(baseURL,
@@ -111,7 +121,15 @@ construct_api_requests <- function(service,
                                     .multi = "comma")    
   }
 
-  if(POST){  
+  #POST list are the arguments that need to be in the POST body
+  post_list <- full_list[!names(full_list) %in% names(get_list)]
+  
+  post_params <- explode_post(post_list)
+  
+  # Should we do a POST?
+  POST = length(post_params) > 0
+  
+  if(POST){
     baseURL <- baseURL |>
       httr2::req_headers(`Content-Type` = "application/query-cql-json") 
 
@@ -126,7 +144,7 @@ construct_api_requests <- function(service,
     baseURL <- httr2::req_body_raw(baseURL, x) 
 
   } else {
-    baseURL <- explode_query(baseURL, POST = FALSE, full_list)
+    baseURL <- explode_query(baseURL, POST = FALSE, full_list, multi = "comma")
   }
 
   return(baseURL)

R/get_ogc_data.R

@@ -25,12 +25,7 @@ get_ogc_data <- function(args,
 
   req <- do.call(construct_api_requests, args)
 
-  if("no_paging" %in% names(args)){
-    no_paging <- args[["no_paging"]]
-    args[["no_paging"]] <- NULL    
-  } else {
-    no_paging <- FALSE
-  }
+  no_paging <- grepl("f=csv", req$url)
 
   message("Requesting:\n", req$url)
 
@@ -68,7 +63,7 @@ get_ogc_data <- function(args,
 
   attr(return_list, "request") <- req
   attr(return_list, "queryTime") <- Sys.time()
-  return_list
+  return(return_list)
 }
 
 order_results <- function(df){

R/read_waterdata_continuous.R

@@ -8,11 +8,13 @@
 #' for new direct download functions that are expected to be available sometime
 #' in 2026.
 #' 
-#' Geometry output is not supported in the continuous data API
+#' Geometry output is not supported in the continuous data API endpoint.
 #' 
 #' @export
 #' @param monitoring_location_id `r get_params("continuous")$monitoring_location_id`
+#' Multiple monitoring_location_ids can be requested as a character vector.
 #' @param parameter_code `r get_params("continuous")$parameter_code`
+#' Multiple parameter_codes can be requested as a character vector.
 #' @param time `r get_params("continuous")$time`. 
 #' You can also use a vector of length 2: the first value being the starting date,
 #' the second value being the ending date. NA's within the vector indicate a
@@ -23,10 +25,8 @@
 #' @param approval_status `r get_params("continuous")$approval_status`
 #' @param last_modified `r get_params("continuous")$last_modified`
 #' @param time_series_id `r get_params("continuous")$time_series_id`
+#' Multiple time_series_ids can be requested as a character vector.
 #' @param qualifier `r get_params("continuous")$qualifier`
-#' @param statistic_id `r get_params("continuous")$statistic_id`. Note that 
-#' for continuous data, the statistic_id is almost universally 00011. 
-#' Requesting anything else will most-likely cause a timeout. 
 #' @param properties A vector of requested columns to be returned from the query.
 #' Available options are: 
 #' `r dataRetrieval:::get_properties_for_docs("continuous", "continuous_id")`.
@@ -73,7 +73,6 @@ read_waterdata_continuous <- function(monitoring_location_id = NA_character_,
                                       approval_status = NA_character_,
                                       unit_of_measure = NA_character_,
                                       qualifier = NA_character_,
-                                      statistic_id = NA_character_,
                                       value = NA,
                                       last_modified = NA_character_,
                                       time = NA_character_,
@@ -87,10 +86,6 @@ read_waterdata_continuous <- function(monitoring_location_id = NA_character_,
   args <- mget(names(formals()))
   args[["skipGeometry"]] <- TRUE
 
-  if(!is.na(statistic_id) & !all(statistic_id == "00011")){
-    warning("With few if any exceptions, statistic_id is always 00011 for continuous data, and requesting other statistic ids will likely return no data.")
-  }
-  
   return_list <- get_ogc_data(args,
                               output_id, 
                               service)

R/read_waterdata_daily.R

@@ -4,8 +4,11 @@
 #' 
 #' @export
 #' @param monitoring_location_id `r get_params("daily")$monitoring_location_id`
+#' Multiple monitoring_location_ids can be requested as a character vector.
 #' @param parameter_code `r get_params("daily")$parameter_code`
+#' Multiple parameter_codes can be requested as a character vector.
 #' @param statistic_id `r get_params("daily")$statistic_id`
+#' Multiple statistic_ids can be requested as a character vector.
 #' @param time `r get_params("daily")$time`
 #' You can also use a vector of length 2: the first value being the starting date,
 #' the second value being the ending date. NA's within the vector indicate a
@@ -16,6 +19,7 @@
 #' @param approval_status `r get_params("daily")$approval_status`
 #' @param last_modified `r get_params("daily")$last_modified`
 #' @param time_series_id `r get_params("daily")$time_series_id`
+#' Multiple time_series_ids can be requested as a character vector.
 #' @param qualifier `r get_params("daily")$qualifier`
 #' @param properties A vector of requested columns to be returned from the query.
 #' Available options are: 
@@ -75,6 +79,9 @@
 #' dv_data_quick <- read_waterdata_daily(monitoring_location_id = site,
 #'                                    parameter_code = "00060",
 #'                                    no_paging = TRUE)
+#'                                    
+#' dv_post <- read_waterdata_daily(monitoring_location_id = site,
+#'                                 approval_status = c("Approved", "Provisional"))
 #' 
 #' }
 read_waterdata_daily <- function(monitoring_location_id = NA_character_,

R/read_waterdata_field_measurements.R

@@ -4,7 +4,9 @@
 #' 
 #' @export
 #' @param monitoring_location_id `r get_params("field-measurements")$monitoring_location_id`
+#' Multiple monitoring_location_ids can be requested as a character vector.
 #' @param parameter_code `r get_params("field-measurements")$parameter_code`
+#' Multiple parameter_codes can be requested as a character vector.
 #' @param observing_procedure_code `r get_params("field-measurements")$observing_procedure_code`
 #' @param time `r get_params("field-measurements")$time`
 #' You can also use a vector of length 2: the first value being the starting date,

R/read_waterdata_latest_continuous.R

@@ -4,7 +4,9 @@
 #' 
 #' @export
 #' @param monitoring_location_id `r get_params("latest-continuous")$monitoring_location_id`
+#' Multiple monitoring_location_ids can be requested as a character vector.
 #' @param parameter_code `r get_params("latest-continuous")$parameter_code`
+#' Multiple parameter_codes can be requested as a character vector.
 #' @param time `r get_params("latest-continuous")$time`
 #' You can also use a vector of length 2: the first value being the starting date,
 #' the second value being the ending date. NA's within the vector indicate a
@@ -15,10 +17,8 @@
 #' @param approval_status `r get_params("latest-continuous")$approval_status`
 #' @param last_modified `r get_params("latest-continuous")$last_modified`
 #' @param time_series_id `r get_params("latest-continuous")$time_series_id`
+#' Multiple time_series_ids can be requested as a character vector.
 #' @param qualifier `r get_params("latest-continuous")$qualifier`
-#' @param statistic_id `r get_params("latest-continuous")$statistic_id`. Note that 
-#' for continuous data, the statistic_id is almost universally 00011. 
-#' Requesting anything else will most-likely cause a timeout. 
 #' @param properties A vector of requested columns to be returned from the query.
 #' Available options are: 
 #' `r dataRetrieval:::get_properties_for_docs("latest-continuous", "latest_continuous_id")`.
@@ -79,7 +79,6 @@
 #' }
 read_waterdata_latest_continuous <- function(monitoring_location_id = NA_character_,
                             parameter_code = NA_character_,
-                            statistic_id = NA_character_,
                             properties = NA_character_,
                             time_series_id = NA_character_,
                             approval_status = NA_character_,

R/read_waterdata_latest_daily.R

@@ -4,8 +4,11 @@
 #' 
 #' @export
 #' @param monitoring_location_id `r get_params("latest-daily")$monitoring_location_id`
+#' Multiple monitoring_location_ids can be requested as a character vector.
 #' @param parameter_code `r get_params("latest-daily")$parameter_code`
+#' Multiple parameter_codes can be requested as a character vector.
 #' @param statistic_id `r get_params("latest-daily")$statistic_id`
+#' Multiple statistic_ids can be requested as a character vector.
 #' @param time `r get_params("latest-daily")$time`
 #' You can also use a vector of length 2: the first value being the starting date,
 #' the second value being the ending date. NA's within the vector indicate a
@@ -16,6 +19,7 @@
 #' @param approval_status `r get_params("latest-daily")$approval_status`
 #' @param last_modified `r get_params("latest-daily")$last_modified`
 #' @param time_series_id `r get_params("latest-daily")$time_series_id`
+#' Multiple time_series_ids can be requested as a character vector.
 #' @param qualifier `r get_params("latest-daily")$qualifier`
 #' @param properties A vector of requested columns to be returned from the query.
 #' Available options are: 

R/read_waterdata_monitoring_location.R

@@ -4,6 +4,7 @@
 #' 
 #' @export
 #' @param monitoring_location_id `r get_params("monitoring-locations")$id`
+#' Multiple monitoring_location_ids can be requested as a character vector.
 #' @param agency_code `r get_params("monitoring-locations")$agency_code`
 #' @param agency_name `r get_params("monitoring-locations")$agency_name`
 #' @param monitoring_location_number `r get_params("monitoring-locations")$monitoring_location_number`

R/read_waterdata_parameter_codes.R

@@ -65,26 +65,10 @@ read_waterdata_parameter_codes <- function(parameter_code = NA_character_,
   args[["skipGeometry"]] <- TRUE
   args[["bbox"]] <- NA
   args[["no_paging"]] <- FALSE # drops id if TRUE
-  
-  if(all(lengths(args) == 1)){
-    return_list <- suppressWarnings(get_ogc_data(args = args,
-                                                 output_id = output_id,
-                                                 service =  service))
-  } else {
-    
-    message("Current API functionality requires pulling the full parameter-codes list.
-It is expected that updates to the API will eliminate this need.")
-    
-    return_list <- read_waterdata_metadata(collection = service, 
-                                           limit = limit)
-    args[["convertType"]] <- NULL
-    args[["skipGeometry"]] <- NULL
-    args[["no_paging"]] <- NULL
-    args_to_filter <- args[!is.na(args)]
-    for(param in names(args_to_filter)){
-      return_list <- return_list[return_list[[param]] %in% args_to_filter[[param]],]
-    }
-  }
+
+  return_list <- get_ogc_data(args = args,
+                              output_id = output_id,
+                              service =  service)
 
   return(return_list)
 }

R/read_waterdata_samples.R

@@ -293,7 +293,7 @@ check_profile <- function(dataProfile, profile_convert){
   return(dataProfile)
 }
 
-explode_query <- function(baseURL, POST = FALSE, x){
+explode_query <- function(baseURL, POST = FALSE, x, multi = "explode"){
 
   if(!is.list(x)){
     return(baseURL)
@@ -307,7 +307,7 @@ explode_query <- function(baseURL, POST = FALSE, x){
     } else {
       baseURL <- httr2::req_url_query(baseURL,
                                       !!!x,
-                                      .multi = "explode")   
+                                      .multi = multi)   
     }
 
   }