Fix ids

R/construct_api_requests.R

@@ -43,37 +43,11 @@
 construct_api_requests <- function(service,
                                    properties = NA_character_,
                                    bbox = NA,
-                                   limit = 10000,
+                                   limit = NA,
+                                   max_results = NA,
                                    skipGeometry = FALSE,
                                    ...){
 
-  schema <- check_OGC_requests(endpoint = service,
-                               type = "schema")
-  all_properties <- names(schema$properties)
-
-  if(!all(is.na(properties))){
-    match.arg(properties, choices = all_properties,
-              several.ok = TRUE)    
-  }
-
-  use_sf <- all(pkg.env$local_sf)
-
-  if(!use_sf){
-    skipGeometry <- TRUE
-  }
-
-  if(all(all_properties[!all_properties %in% c("id", "geometry")] %in% properties)) {
-    # Cleans up URL if we're asking for everything
-    properties <- NA_character_
-  } else {
-    if(all(!is.na(properties))){
-      properties <- gsub("-", "_", properties)
-      properties <- properties[!properties %in% c("id", 
-                                                  "geometry",
-                                                  paste0(gsub("-", "_", service), "_id"))]
-    }
-  }
-
   baseURL <- setup_api(service)
 
   POST <- FALSE
@@ -89,7 +63,19 @@ construct_api_requests <- function(service,
   get_list <- full_list[names(full_list) %in% single_params]
 
   get_list[["skipGeometry"]] <- skipGeometry
-  get_list[["limit"]] <- limit
+
+  if(is.na(limit)){
+    if(!is.na(max_results)){
+      get_list[["limit"]] <- max_results
+    } else {
+      get_list[["limit"]] <- 10000
+    }
+  } else {
+    if(!is.na(max_results)){
+      if(limit > max_results) stop("limit cannot be greater than max_result")
+    }
+    get_list[["limit"]] <- limit
+  }
 
   post_list <- full_list[!names(full_list) %in% single_params]
 
@@ -177,6 +163,111 @@ setup_api <- function(service){
 
 }
 
+#' Switch endpoint id arg
+#' 
+#' @noRd
+#' @return list
+#' @examples
+#' 
+#' l1 <- list("id" = "1234")
+#' dataRetrieval:::switch_arg_id(l1, 
+#'                               id_name = "monitoring_location_id",
+#'                               service = "monitoring-locations")
+#'                               
+#' l2 <- list("monitoring_location_id" = "1234")
+#' dataRetrieval:::switch_arg_id(l2, 
+#'                               id_name = "monitoring_location_id",
+#'                               service = "monitoring-locations")
+#'                               
+#' l3 <- list("monitoring_locations_id" = "1234")
+#' dataRetrieval:::switch_arg_id(l3, 
+#'                               id_name = "monitoring_location_id",
+#'                               service = "monitoring-locations")
+#' 
+switch_arg_id <- function(ls, id_name, service){
+
+  service_id <- paste0(gsub("-", "_", service), "_id")
+  if(!"id" %in% names(ls)){
+    if(service_id %in% names(ls)){
+      ls[["id"]] <- ls[[service_id]]
+    } else {
+      ls[["id"]] <- ls[[id_name]]
+    }
+  }
+
+  ls[[service_id]] <- NULL
+  ls[[id_name]] <- NULL
+  return(ls)
+}
+
+#' Switch properties id
+#' 
+#' @noRd
+#' @return list
+#' @examples
+#' 
+#' properties <- c("id", "state_name", "country_name")
+#' dataRetrieval:::switch_properties_id(properties, 
+#'                               id_name = "monitoring_location_id",
+#'                               service = "monitoring-locations")
+#'                               
+#' properties2 <- c("monitoring_location_id", "state_name", "country_name")
+#' dataRetrieval:::switch_properties_id(properties2, 
+#'                               id_name = "monitoring_location_id",
+#'                               service = "monitoring-locations")
+#'                               
+#' properties3 <- c("monitoring_locations_id", "state_name", "country_name")
+#' dataRetrieval:::switch_properties_id(properties3, 
+#'                               id_name = "monitoring_location_id",
+#'                               service = "monitoring-locations")
+switch_properties_id <- function(properties, id_name, service){
+
+  service_id <- paste0(gsub("-", "_", service), "_id")
+
+  last_letter <- substr(service, nchar(service), nchar(service))
+  if(last_letter == "s"){
+    service_singluar <- substr(service,1, nchar(service)-1)
+    service_id_singular <- paste0(gsub("-", "_", service_singluar), "_id")
+  } else {
+    service_id_singular <- ""
+  }
+
+  if(!"id" %in% properties){
+    if(service_id %in% properties){
+      properties[properties == service_id] <- "id"
+
+    } else if(service_id_singular %in% properties) {
+      properties[properties == service_id_singular] <- "id"
+    } else {
+      properties[properties == id_name] <- "id"
+    }
+  }
+
+  schema <- check_OGC_requests(endpoint = service,
+                               type = "schema")
+  all_properties <- names(schema$properties)
+
+  if(all(all_properties[!all_properties %in% c("id", "geometry")] %in% properties)) {
+    # Cleans up URL if we're asking for everything
+    properties <- NA_character_
+  } else {
+    if(all(!is.na(properties))){
+      properties <- gsub("-", "_", properties)
+      properties <- properties[!properties %in% c("id", 
+                                                  "geometry",
+                                                  paste0(gsub("-", "_", service), "_id"))]
+    }
+  }
+
+  if(!all(is.na(properties))){
+    match.arg(properties, choices = all_properties,
+              several.ok = TRUE)    
+  }
+
+  return(properties)
+}
+
+
 #' Format the date request
 #' 
 #' Users will want to give either start/end dates or 

R/read_USGS_daily.R

@@ -23,10 +23,13 @@
 #' depth). Coordinates are assumed to be in crs 4326. The expected format is a numeric 
 #' vector structured: c(xmin,ymin,xmax,ymax). Another way to think of it is c(Western-most longitude,
 #' Southern-most latitude, Eastern-most longitude, Northern-most longitude).
-#' @param limit The optional limit parameter limits the number of items that are
-#' presented in the response document. Only items are counted that are on the
-#' first level of the collection in the response document. Nested objects
-#' contained within the explicitly requested items shall not be counted.
+#' @param limit The optional limit parameter is used to control the subset of the 
+#' selected features that should be returned in each page. The maximum allowable
+#' limit is 10000. It may be beneficial to set this number lower if your internet
+#' connection is spotty. The default (`NA`) will set the limit to the maximum
+#' allowable limit for the service.
+#' @param max_results The optional maximum number of rows to return. This value
+#' must be less than the requested limit. 
 #' @param skipGeometry This option can be used to skip response geometries for
 #' each feature. The returning object will be a data frame with no spatial
 #' information.
@@ -38,8 +41,8 @@
 #' site <- "USGS-02238500"
 #' pcode <- "00060"
 #' dv_data_sf <- read_USGS_daily(monitoring_location_id = site,
-#'                         parameter_code = "00060", 
-#'                         time = c("2021-01-01", "2022-01-01"))
+#'                               parameter_code = "00060", 
+#'                               time = c("2021-01-01", "2022-01-01"))
 #'
 #' dv_data_trim <- read_USGS_daily(monitoring_location_id = site,
 #'                           parameter_code = "00060", 
@@ -49,58 +52,69 @@
 #'                           time = c("2021-01-01", "2022-01-01"))
 #'
 #' dv_data <- read_USGS_daily(monitoring_location_id = site,
-#'                         parameter_code = "00060",
-#'                         skipGeometry = TRUE)
+#'                            parameter_code = "00060",
+#'                            skipGeometry = TRUE)
 #'                         
 #' dv_data_period <- read_USGS_daily(monitoring_location_id = site,
-#'                         parameter_code = "00060",
-#'                         time = "P7D")
+#'                                   parameter_code = "00060",
+#'                                   time = "P7D")
 #' 
 #' multi_site <- read_USGS_daily(monitoring_location_id =  c("USGS-01491000",
-#'                                                        "USGS-01645000"),
-#'                         parameter_code = c("00060", "00010"),
-#'                         limit = 500,
-#'                         time = c("2023-01-01", "2024-01-01"))
+#'                                                           "USGS-01645000"),
+#'                               parameter_code = c("00060", "00010"),
+#'                               limit = 500,
+#'                               time = c("2023-01-01", "2024-01-01"))
 #' 
 #' }
 read_USGS_daily <- function(monitoring_location_id = NA_character_,
-                         parameter_code = NA_character_,
-                         statistic_id = NA_character_,
-                         properties = NA_character_,
-                         time_series_id = NA_character_,
-                         daily_id = NA_character_,
-                         approval_status = NA_character_,
-                         unit_of_measure = NA_character_,
-                         qualifier = NA_character_,
-                         value = NA,
-                         last_modified = NA_character_,
-                         limit = 10000,
-                         skipGeometry = NA,
-                         time = NA_character_,
-                         bbox = NA,
-                         convertType = TRUE){
+                            parameter_code = NA_character_,
+                            statistic_id = NA_character_,
+                            properties = NA_character_,
+                            time_series_id = NA_character_,
+                            daily_id = NA_character_,
+                            approval_status = NA_character_,
+                            unit_of_measure = NA_character_,
+                            qualifier = NA_character_,
+                            value = NA,
+                            last_modified = NA_character_,
+                            skipGeometry = NA,
+                            time = NA_character_,
+                            bbox = NA,
+                            limit = NA,
+                            max_results = NA,
+                            convertType = TRUE){
 
   message("Function in development, use at your own risk.")
 
   service <- "daily"
+  output_id <- "daily_id"
+
   args <- mget(names(formals()))
-  args[["id"]] <- args[["daily_id"]]
-  args[["daily_id"]] <- NULL
-  args[["convertType"]] <- NULL
   args[["service"]] <-  service
+
+  args <- switch_arg_id(args, 
+                        id_name = output_id, 
+                        service = service)
+
+  args[["properties"]] <- switch_properties_id(properties, 
+                                               id_name = output_id, 
+                                               service = service)
+
+  args[["convertType"]] <- NULL
+
   dv_req <- do.call(construct_api_requests, args)
 
-  return_list <- walk_pages(dv_req)
+  return_list <- walk_pages(dv_req, max_results)
 
   return_list <- deal_with_empty(return_list, properties, service)
 
   if(convertType) return_list <- cleanup_cols(return_list,
                                               service = "daily")
+
+  return_list <- rejigger_cols(return_list, properties, output_id)
 
   return_list <- return_list[order(return_list$time, return_list$monitoring_location_id), ]
 
-  return_list <- rejigger_cols(return_list, properties, service)
-
   return(return_list)
 }
 

R/read_USGS_data.R

@@ -65,7 +65,13 @@ read_USGS_data <- function(service,
     httr2::req_headers(`Content-Type` = "application/query-cql-json") |> 
     httr2::req_body_raw(CQL) 
 
-  return_list <- walk_pages(data_req)
+  if("max_results" %in% names(args)){
+    max_results <- args[["max_results"]]
+  } else {
+    max_results <- NA
+  }
+
+  return_list <- walk_pages(data_req, max_results)
 
   return_list <- deal_with_empty(return_list, args[["properties"]], service)