Merge pull request #125 from rOpenSpain/123-spod_quick_get_od-fails-s…

…ometimes-because-fresh-csvs-are-not-always-pre-aggregated-in-the-graphql-api

123 spod quick get od fails sometimes because fresh csvs are not always pre aggregated in the graphql api

R/internal-utils.R

@@ -405,3 +405,55 @@ spod_convert_dates_to_ranges <- function(dates) {
 
   return(range_strings)
 }
+
+#' Get valid dates from the GraphQL API
+#' @return A `Date` vector of dates that are valid to request data with \code{spod_quick_get_od()}.
+#' @keywords internal
+spod_graphql_valid_dates <- function(){
+  graphql_endpoint <- getOption("spanishoddata.graphql_api_endpoint")
+
+  # Define the GraphQL query
+  graphql_query <- list(
+    query = "query { find_date_ranges { start_date, end_date } }",
+    variables = structure(list(), .Names = character(0))  # Empty named list so that it serialises to {} not []
+  )
+
+
+  # Send the POST request
+  response <- httr2::request(graphql_endpoint) |>
+    httr2::req_headers(
+      "Content-Type" = "application/json",  # Ensure correct header
+      "User-Agent" = "R-httr2-client"
+    ) |>
+    httr2::req_body_json(graphql_query) |>  # Pass query as JSON
+    httr2::req_perform()
+
+  # parse the response
+  response_data <- httr2::resp_body_json(response, simplifyVector = TRUE)
+  dates_table <- response_data$data$find_date_ranges |> 
+    dplyr::mutate(end_date = dplyr::if_else(
+      condition = .data$end_date == "2024-09-31",
+      true = "2024-09-30",
+      false = .data$end_date
+    ))
+
+  dates_table
+
+  # Convert start_date and end_date columns to Date class
+  dates_table$start_date <- as.Date(dates_table$start_date)
+  dates_table$end_date <- as.Date(dates_table$end_date)
+
+  # Generate a single vector of all dates in the intervals
+  # Generate all dates for each interval
+  date_sequences <- mapply(
+    seq.Date,
+    from = dates_table$start_date,
+    to = dates_table$end_date,
+    by = "day"
+  )
+
+  # Flatten the list of date sequences into a single vector and remove duplicates
+  dates <- as.Date(unique(unlist(date_sequences)))
+
+  return(dates)
+}

R/onload.R

@@ -0,0 +1,11 @@
+.onLoad <- function(libname, pkgname) {
+  op <- options()
+  op.spanishoddata <- list(
+    spanishoddata.graphql_api_endpoint = "https://mapas-movilidad.transportes.gob.es/api/graphql",
+    spanishoddata.user_agent = "spanishoddata R package, https://github.com/rOpenSpain/spanishoddata/"
+  )
+  toset <- !(names(op.spanishoddata) %in% names(op))
+  if (any(toset)) options(op.spanishoddata[toset])
+
+  invisible()
+}

R/quick-get.R

@@ -106,7 +106,7 @@ spod_quick_get_od <- function(
   }
 
   # check if date is within valid range
-  valid_dates <- spod_get_valid_dates(ver = 2)
+  valid_dates <- spod_graphql_valid_dates()
   is_valid_date <- lubridate::ymd(date) %in% valid_dates
   if (!is_valid_date) {
     stop(
@@ -176,7 +176,7 @@ spod_quick_get_od <- function(
   if (length(id_destination) == 0) id_destination <- NULL
 
   # Define the GraphQL endpoint
-  graphql_endpoint <- "https://mapas-movilidad.transportes.gob.es/api/graphql"
+  graphql_endpoint <- getOption("spanishoddata.graphql_api_endpoint")
 
   # Construct the GraphQL query
   graphql_query <- list(
@@ -199,14 +199,20 @@ spod_quick_get_od <- function(
   response <- httr2::request(graphql_endpoint) |>
     httr2::req_headers(
       "Content-Type" = "application/json",
-      "User-Agent" = "spanishoddata R package, https://github.com/rOpenSpain/spanishoddata/"
+      "User-Agent" = getOption("spanishoddata.user_agent")
     ) |>
     httr2::req_body_json(graphql_query) |>
     httr2::req_perform()
 
   # Parse the response
   response_data <- httr2::resp_body_json(response, simplifyVector = TRUE)
 
+  # check if data is empty
+
+  if (length(response_data$data[[1]]) == 0) {
+    stop("You have selected a date that is reported by the remote server as valid, but in fact there is no data. Please select a different date.")
+  }
+
   od <- tibble::as_tibble(response_data$data[[1]]) |> 
     dplyr::select(
       id_origin = .data$origin_muni,