merge feature/progress-and-retry and resolve merge conflict

Merge branch 'feature/progress-and-retry' into v0.5.11

# Conflicts:
#	R/cancensus.R
#	man/get_census.Rd

Author: mountainMath

R/cancensus.R

@@ -24,6 +24,7 @@
 #'   for each census vector variable, containing the original suppression codes (e.g., 'x', 'F', '...')
 #'   before they are converted to NA. Useful for understanding data quality and suppression patterns.
 #'   Default is FALSE. Use \code{\link{census_data_quality}} to analyze suppression patterns.
+#' @param retry Integer If greater than zero, automatically retry failed API requests with exponential backoff for specified maximum number of times. Defaults to 0.
 #'
 #' @source Census data and boundary geographies are reproduced and distributed on
 #' an "as is" basis with the permission of Statistics Canada (Statistics Canada 1996; 2001; 2006; 2011; 2016).
@@ -56,8 +57,8 @@ get_census <- function (dataset, regions, level=NA, vectors=c(), geo_format = NA
                         resolution = 'simplified',
                         labels = "detailed",
                         use_cache=TRUE, quiet=FALSE, api_key=Sys.getenv("CM_API_KEY"),
-                        preserve_suppression_flags=FALSE)
-  {
+                        preserve_suppression_flags=FALSE,
+                        retry=0) {
 
   # API and data recall checks
   first_run_checks()
@@ -149,13 +150,32 @@ get_census <- function (dataset, regions, level=NA, vectors=c(), geo_format = NA
         stop(paste("No API key set. Use set_cancensus_api_key('<your API key>') to set one, or set_cancensus_api_key('<your API key>', install = TRUE) to save it permanently in your .Renviron."))
       }
       url <- paste0(base_url, "data.csv")
-      response <- if (!quiet) {
-        message("Querying CensusMapper API...")
-        httr::POST(url, httr::progress(), body=params)
+      if (!quiet) message("Querying CensusMapper API for data...")
+
+      # Define the API call
+      make_data_call <- function() {
+        if (!quiet) {
+          httr::POST(url, httr::progress(), body=params)
+        } else {
+          httr::POST(url, body=params)
+        }
+      }
+
+      # Execute with or without retry
+      response <- if (retry>0) {
+        retry_api_call(make_data_call, max_retries = retry, quiet = quiet)
       } else {
-        httr::POST(url, body=params)
+        make_data_call()
       }
+
       handle_cm_status_code(response, NULL)
+
+      # Report download size
+      content_length <- as.numeric(response$headers$`content-length`)
+      if (!quiet && !is.na(content_length) && content_length > 0) {
+        message(sprintf("Downloaded %s of data.", format_bytes(content_length)))
+      }
+
       data_version <- response$headers$`data-version`
 
 
@@ -221,13 +241,32 @@ get_census <- function (dataset, regions, level=NA, vectors=c(), geo_format = NA
         stop(paste("No API key set. Use set_cancensus_api_key('<your API key>') to set one, or set_cancensus_api_key('<your API key>', install = TRUE) to save it permanently in your .Renviron."))
       }
       url <- paste0(base_url, "geo.geojson")
-      response <- if (!quiet) {
-        message("Querying CensusMapper API...")
-        httr::POST(url, httr::progress(),body=params)
+      if (!quiet) message("Querying CensusMapper API for geometry...")
+
+      # Define the API call
+      make_geo_call <- function() {
+        if (!quiet) {
+          httr::POST(url, httr::progress(), body=params)
+        } else {
+          httr::POST(url, body=params)
+        }
+      }
+
+      # Execute with or without retry
+      response <- if (retry) {
+        retry_api_call(make_geo_call, max_retries = max_retries, quiet = quiet)
       } else {
-        httr::POST(url,body=params)
+        make_geo_call()
       }
+
       handle_cm_status_code(response, NULL)
+
+      # Report download size
+      content_length <- as.numeric(response$headers$`content-length`)
+      if (!quiet && !is.na(content_length) && content_length > 0) {
+        message(sprintf("Downloaded %s of geometry.", format_bytes(content_length)))
+      }
+
       geo_version <- response$headers$`data-version`
       write(httr::content(response, type = "text", encoding = "UTF-8"), file = geo_file) # cache result
       file_info <- file.info(geo_file)
@@ -245,6 +284,9 @@ get_census <- function (dataset, regions, level=NA, vectors=c(), geo_format = NA
        transform_geo(level) #%>%
       # sf::st_sf(agr="constant") # just in case
 
+    if (!quiet) {
+      message(sprintf("Processing %s geographic features.", format(nrow(geos), big.mark = ",")))
+    }
 
     result <- if (is.null(result)) {
       geos

R/helpers.R

@@ -82,6 +82,70 @@ dataset_from_vector_list <- function(vector_list){
 
 cancensus_na_strings <- c("x", "X", "F", "...", "..", "-","N","*","**")
 
+#' Retry an API call with exponential backoff
+#'
+#' @param call_fn A function that performs the API call and returns an httr response
+#' @param max_retries Maximum number of retry attempts (default: 3)
+#' @param quiet If TRUE, suppress retry messages
+#' @return The httr response object
+#' @keywords internal
+retry_api_call <- function(call_fn, max_retries = 3, quiet = FALSE) {
+ attempt <- 1
+ last_error <- NULL
+
+ while (attempt <= max_retries) {
+   tryCatch({
+     response <- call_fn()
+
+     # Check for transient HTTP errors (5xx, timeout, connection errors)
+     status <- httr::status_code(response)
+     if (status >= 500 && status < 600 && attempt < max_retries) {
+       # Server error - retry
+       wait_time <- 2 ^ (attempt - 1)  # Exponential backoff: 1, 2, 4 seconds
+       if (!quiet) {
+         message(sprintf("Server error (HTTP %d), retrying in %ds (attempt %d/%d)...",
+                         status, wait_time, attempt + 1, max_retries))
+       }
+       Sys.sleep(wait_time)
+       attempt <- attempt + 1
+       next
+     }
+
+     # Success or non-retryable error
+     return(response)
+
+   }, error = function(e) {
+     last_error <<- e
+     # Network errors - retry
+     if (attempt < max_retries) {
+       wait_time <- 2 ^ (attempt - 1)
+       if (!quiet) {
+         message(sprintf("Network error: %s. Retrying in %ds (attempt %d/%d)...",
+                         conditionMessage(e), wait_time, attempt + 1, max_retries))
+       }
+       Sys.sleep(wait_time)
+       attempt <<- attempt + 1
+     } else {
+       stop(e)
+     }
+   })
+ }
+
+ # If we've exhausted retries, throw the last error
+ if (!is.null(last_error)) {
+   stop(last_error)
+ }
+}
+
+#' Format bytes to human-readable size
+#' @keywords internal
+format_bytes <- function(bytes) {
+ if (bytes < 1024) return(paste0(bytes, " B"))
+ if (bytes < 1024^2) return(sprintf("%.1f KB", bytes / 1024))
+ if (bytes < 1024^3) return(sprintf("%.1f MB", bytes / 1024^2))
+ return(sprintf("%.1f GB", bytes / 1024^3))
+}
+
 as.num = function(x, na.strings = cancensus_na_strings) {
   stopifnot(is.character(x))
   na = x %in% na.strings