Fix walkerke#151

Adds validation for benchmark and vintage

R/geocode.R

@@ -134,8 +134,13 @@ call_geolocator <- function(street, city, state, zip = NA) {
 #'
 #' @param lat A numeric value
 #' @param lon A numeric value
-#' @param benchmark time period when a snapshot of address ranges was taken
-#' @param vintage census or survey that the address range relates to
+#' @param benchmark time period when a snapshot of address ranges was taken. As
+#'   of early 2024, supported values include "Public_AR_Current",
+#'   "Public_AR_Census2020", "Public_AR_ACS2023".
+#' @param vintage census or survey that the address range relates to. See the
+#'   [Find Geographic Coordinates
+#'   form](https://geocoding.geo.census.gov/geocoder/geographies/coordinates)
+#'   for supported values for each benchmark.
 #'
 #' @return A character string representing the Census block of the supplied
 #'   lat/lon.
@@ -147,27 +152,10 @@ call_geolocator <- function(street, city, state, zip = NA) {
 #' @author Mark Richards, \email{Mark.Richards.002@@gmail.com}
 #' @export
 #'
-call_geolocator_latlon <- function(lat, lon, benchmark, vintage) {
-  if(missing(benchmark)) {
-    benchmark<-"Public_AR_Current"
-  } else {
-    benchmark<-benchmark
-  }
-  if(missing(vintage)) {
-    vintage<-"Current_Current"
-  } else {
-    vintage<-vintage
-  }
+call_geolocator_latlon <- function(lat, lon, benchmark = NULL, vintage = NULL) {
   # Build url
-  call_start <- "https://geocoding.geo.census.gov/geocoder/geographies/coordinates?"
-
-  url <- paste0("x=", lon,"&y=", lat)
-
-  benchmark0 <- paste0("&benchmark=", benchmark)
-  vintage0 <- paste0("&vintage=", vintage, "&format=json")
+  url_full <- build_geolocator_laton_url(lat, lon, benchmark, vintage)
 
-  url_full <- paste0(call_start, url, benchmark0, vintage0)
-  #print(url_full)
   # Check response
   r <- httr::GET(url_full)
   httr::stop_for_status(r)
@@ -201,3 +189,71 @@ call_geolocator_latlon <- function(lat, lon, benchmark, vintage) {
 
   }
 }
+
+#' @noRd
+build_geolocator_laton_url <- function(
+    lat,
+    lon,
+    benchmark = NULL,
+    vintage = NULL,
+    base_url = "https://geocoding.geo.census.gov/geocoder/geographies/coordinates",
+    call = caller_env()
+    ) {
+  benchmark <- benchmark %||% "Public_AR_Current"
+  benchmark <- set_geolocator_benchmark(benchmark, call = call)
+
+  vintage <- vintage %||% "Current_Current"
+  vintage <- set_geolocator_vintage(vintage, benchmark, call = call)
+
+  paste0(
+    base_url, "?",
+    "x=", lon,"&y=", lat,
+    "&benchmark=", benchmark,
+    "&vintage=", vintage, "&format=json"
+  )
+}
+
+#' @noRd
+set_geolocator_benchmark <- function(
+    benchmark,
+    values = c("Public_AR_Current", "Public_AR_Census2020", "Public_AR_ACS2023"),
+    call = caller_env()
+) {
+
+  if (!(benchmark %in% values)) {
+    resp <- httr::GET("https://geocoding.geo.census.gov/geocoder/benchmarks")
+    values <- httr::content(resp)
+    values <- as.character(sapply(values[["benchmarks"]], `[`, "benchmarkName"))
+  }
+
+  arg_match(benchmark, values, error_call = call)
+}
+
+#' See form for possible values:
+#' https://geocoding.geo.census.gov/geocoder/geographies/coordinates?form
+#'
+#' @noRd
+set_geolocator_vintage <- function(
+    vintage,
+    benchmark,
+    call = caller_env()) {
+  if (benchmark == "Public_AR_Census2020") {
+    prefix <- c("Census2010", "Census2020")
+    suffix <- "Census2020"
+  } else {
+    prefix <- c(
+      "Current",
+      "Census2010",
+      "Census2020",
+      paste0("ACS", 2017:2023)
+    )
+
+    suffix <- switch (
+      benchmark,
+      "Public_AR_Current" = "Current",
+      "Public_AR_ACS2023" = "ACS2023"
+    )
+  }
+
+  arg_match(vintage, paste0(prefix, "_", suffix), error_call = call)
+}