From 66487d01f590788d7c19ac90c15b046fd72accfe Mon Sep 17 00:00:00 2001 From: Christoph Scheuch <19249734+christophscheuch@users.noreply.github.com> Date: Mon, 4 Nov 2024 19:33:09 +0100 Subject: [PATCH 01/10] Add draft for ids_bulk* functions --- R/ids_bulk.R | 14 ++++++++++++++ R/ids_bulk_files.R | 21 +++++++++++++++++++++ R/ids_bulk_series.R | 23 +++++++++++++++++++++++ 3 files changed, 58 insertions(+) create mode 100644 R/ids_bulk.R create mode 100644 R/ids_bulk_files.R create mode 100644 R/ids_bulk_series.R diff --git a/R/ids_bulk.R b/R/ids_bulk.R new file mode 100644 index 0000000..9905fca --- /dev/null +++ b/R/ids_bulk.R @@ -0,0 +1,14 @@ +ids_bulk <- function(file_url, file_path = tempfile(fileext = ".xlsx")) { + + cli::cli_inform("Downloading file to: {file_path}") + utils::download.file(file_url, destfile = file_path, quiet = TRUE) + + cli::cli_inform("Reading in file.") + bulk <- readxl::read_excel(file_path) + + cli::cli_inform("Deleting file.") + unlink(file_path) + + bulk +} + diff --git a/R/ids_bulk_files.R b/R/ids_bulk_files.R new file mode 100644 index 0000000..cff7737 --- /dev/null +++ b/R/ids_bulk_files.R @@ -0,0 +1,21 @@ +ids_bulk_files <- function() { + + ids_meta <- jsonlite::fromJSON( + txt = paste0( + "https://datacatalogapi.worldbank.org/ddhxext/DatasetDownload", + "?dataset_unique_id=0038015&version_id=" + ) + ) + + bulk_files <- ids_meta$resources |> + as_tibble() |> + View() + select(name, distribution, last_updated_date) |> + unnest(distribution) |> + filter(distribution_format == "xlsx") |> + select(file_name = name, file_url = url, last_updated_date) |> + mutate(last_updated_date = as.Date(last_updated_date)) + + bulk_files + +} diff --git a/R/ids_bulk_series.R b/R/ids_bulk_series.R new file mode 100644 index 0000000..51d18f4 --- /dev/null +++ b/R/ids_bulk_series.R @@ -0,0 +1,23 @@ +ids_bulk_series <- function() { + + ids_meta <- jsonlite::fromJSON( + txt = paste0( + "https://datacatalogapi.worldbank.org/ddhxext/DatasetDownload", + "?dataset_unique_id=0038015&version_id=" + ) + ) + + bulk_series <- ids_meta$indicators |> + as_tibble() |> + select(lineage) |> + unnest(lineage) |> + select(series_id = harvest_system_reference) + + api_series <- ids_list_series() + + bulk_series <- bulk_series |> + inner_join(api_series, join_by(series_id)) + + bulk_series + +} From 2645798f8c188d3b08cf769715f29209208bafe9 Mon Sep 17 00:00:00 2001 From: Christoph Scheuch <19249734+christophscheuch@users.noreply.github.com> Date: Mon, 4 Nov 2024 19:37:14 +0100 Subject: [PATCH 02/10] Add readxl as suggested import --- DESCRIPTION | 1 + R/ids_bulk.R | 4 ++++ 2 files changed, 5 insertions(+) diff --git a/DESCRIPTION b/DESCRIPTION index cd3da55..1a866b2 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -27,6 +27,7 @@ Suggests: devtools (>= 2.4.5), lintr (>= 3.1.2), quarto, + readxl, rmarkdown, testthat (>= 3.0.0), languageserver (>= 0.3.16) diff --git a/R/ids_bulk.R b/R/ids_bulk.R index 9905fca..30a467a 100644 --- a/R/ids_bulk.R +++ b/R/ids_bulk.R @@ -1,5 +1,9 @@ ids_bulk <- function(file_url, file_path = tempfile(fileext = ".xlsx")) { + rlang::check_installed( + "readxl", reason = "to download bulk files." + ) + cli::cli_inform("Downloading file to: {file_path}") utils::download.file(file_url, destfile = file_path, quiet = TRUE) From 9b249da791255e08bfe44ea4c53823796e21df74 Mon Sep 17 00:00:00 2001 From: Christoph Scheuch <19249734+christophscheuch@users.noreply.github.com> Date: Tue, 5 Nov 2024 09:23:37 +0100 Subject: [PATCH 03/10] Update ids_bulk() with selected columns --- R/ids_bulk.R | 28 +++++++++++++++++++++++++++- R/ids_bulk_files.R | 1 - 2 files changed, 27 insertions(+), 2 deletions(-) diff --git a/R/ids_bulk.R b/R/ids_bulk.R index 30a467a..692b860 100644 --- a/R/ids_bulk.R +++ b/R/ids_bulk.R @@ -8,7 +8,33 @@ ids_bulk <- function(file_url, file_path = tempfile(fileext = ".xlsx")) { utils::download.file(file_url, destfile = file_path, quiet = TRUE) cli::cli_inform("Reading in file.") - bulk <- readxl::read_excel(file_path) + available_columns <- readxl::read_excel(path = file_path, n_max = 0) |> + colnames() + relevant_columns <- tibble(names = available_columns) |> + mutate(type = if_else(grepl(pattern = "[0:9]", names), "numeric", "text")) |> + filter(!grepl("column", names, ignore.case = TRUE)) + + bulk_raw <- readxl::read_excel( + path = file_path, + range = readxl::cell_cols(1:nrow(relevant_columns)), + col_types = relevant_columns$type + ) + + cli::cli_inform("Processing file.") + bulk <- bulk_raw |> + select(-c(`Country Name`, `Classification Name`)) |> + select( + geography_id = `Country Code`, + series_id = `Series Code`, + counterpart_id = `Series Name`, + everything() + ) |> + tidyr::pivot_longer( + cols = -c(geography_id, series_id, counterpart_id), + names_to = "year" + ) |> + mutate(year = as.integer(year)) |> + tidyr::drop_na() cli::cli_inform("Deleting file.") unlink(file_path) diff --git a/R/ids_bulk_files.R b/R/ids_bulk_files.R index cff7737..30d5c36 100644 --- a/R/ids_bulk_files.R +++ b/R/ids_bulk_files.R @@ -9,7 +9,6 @@ ids_bulk_files <- function() { bulk_files <- ids_meta$resources |> as_tibble() |> - View() select(name, distribution, last_updated_date) |> unnest(distribution) |> filter(distribution_format == "xlsx") |> From 13d7390c6235a877eab9e1f7f2a8910aa5187162 Mon Sep 17 00:00:00 2001 From: Christoph Scheuch <19249734+christophscheuch@users.noreply.github.com> Date: Tue, 5 Nov 2024 14:38:46 +0100 Subject: [PATCH 04/10] Finalize ids_bulk* functions --- DESCRIPTION | 3 +- NAMESPACE | 4 +++ R/ids_bulk.R | 78 ++++++++++++++++++++++++++++++++++-------- R/ids_bulk_files.R | 33 +++++++++++++++--- R/ids_bulk_series.R | 36 ++++++++++++++++--- R/wbids-package.R | 2 +- man/ids_bulk.Rd | 44 ++++++++++++++++++++++++ man/ids_bulk_files.Rd | 27 +++++++++++++++ man/ids_bulk_series.Rd | 32 +++++++++++++++++ 9 files changed, 233 insertions(+), 26 deletions(-) create mode 100644 man/ids_bulk.Rd create mode 100644 man/ids_bulk_files.Rd create mode 100644 man/ids_bulk_series.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 1a866b2..ddc8887 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -25,9 +25,10 @@ Imports: Suggests: curl, devtools (>= 2.4.5), + jsonlite (>= 1.0.0), lintr (>= 3.1.2), quarto, - readxl, + readxl (>= 1.0.0), rmarkdown, testthat (>= 3.0.0), languageserver (>= 0.3.16) diff --git a/NAMESPACE b/NAMESPACE index 27441c4..2a56817 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,8 @@ # Generated by roxygen2: do not edit by hand +export(ids_bulk) +export(ids_bulk_files) +export(ids_bulk_series) export(ids_get) export(ids_list_counterparts) export(ids_list_geographies) @@ -12,5 +15,6 @@ importFrom(purrr,map) importFrom(rlang,eval_tidy) importFrom(rlang,parse_expr) importFrom(tidyr,crossing) +importFrom(tidyr,pivot_longer) importFrom(tidyr,unnest) importFrom(tidyr,unnest_wider) diff --git a/R/ids_bulk.R b/R/ids_bulk.R index 692b860..44f1a8c 100644 --- a/R/ids_bulk.R +++ b/R/ids_bulk.R @@ -1,44 +1,92 @@ -ids_bulk <- function(file_url, file_path = tempfile(fileext = ".xlsx")) { +#' Download and Process Bulk Data File for International Debt Statistics +#' +#' This function downloads a data file from the World Bank International Debt +#' Statistics (IDS), reads and processes the data into a tidy format. +#' +#' @param file_url A character string specifying the URL of the Excel file to +#' download. This parameter is required (see \link{ids_bulk_files}). +#' @param file_path An optional character string specifying the file path where +#' the downloaded file will be saved. Defaults to a temporary file with `.xlsx` +#' extension. The file will automatically be deleted after processing. +#' @param quiet A logical parameter indicating whether messages should be +#' printed to the console. +#' +#' @return A tibble containing processed debt statistics data with the following +#' columns: +#' \describe{ +#' \item{geography_id}{The unique identifier for the geography (e.g., "ZMB").} +#' \item{series_id}{The unique identifier for the series (e.g., +#' "DT.DOD.DPPG.CD").} +#' \item{counterpart_id}{The unique identifier for the counterpart series.} +#' \item{year}{The year corresponding to the data (as an integer).} +#' \item{value}{The numeric value representing the statistic for the given +#' geography, series, counterpart, and year.} +#' } +#' +#' @export +#' +#' @examplesIf curl::has_internet() +#' available_files <- ids_bulk_files() +#' data <- ids_bulk( +#' available_files$file_url[1] +#' ) +#' +ids_bulk <- function( + file_url, file_path = tempfile(fileext = ".xlsx"), quiet = FALSE +) { rlang::check_installed( "readxl", reason = "to download bulk files." ) - cli::cli_inform("Downloading file to: {file_path}") - utils::download.file(file_url, destfile = file_path, quiet = TRUE) + if (!quiet) { + cli::cli_inform("Downloading file to: {file_path}") + } + + utils::download.file(file_url, destfile = file_path, quiet = quiet) + + if (!quiet) { + cli::cli_inform("Reading in file.") + } - cli::cli_inform("Reading in file.") available_columns <- readxl::read_excel(path = file_path, n_max = 0) |> colnames() relevant_columns <- tibble(names = available_columns) |> - mutate(type = if_else(grepl(pattern = "[0:9]", names), "numeric", "text")) |> + mutate( + type = if_else(grepl(pattern = "[0:9]", .data$names), "numeric", "text") + ) |> filter(!grepl("column", names, ignore.case = TRUE)) bulk_raw <- readxl::read_excel( path = file_path, - range = readxl::cell_cols(1:nrow(relevant_columns)), + range = readxl::cell_cols(seq_len(nrow(relevant_columns))), col_types = relevant_columns$type ) - cli::cli_inform("Processing file.") + if (!quiet) { + cli::cli_inform("Processing file.") + } + bulk <- bulk_raw |> - select(-c(`Country Name`, `Classification Name`)) |> + select(-c("Country Name", "Classification Name")) |> select( - geography_id = `Country Code`, - series_id = `Series Code`, - counterpart_id = `Series Name`, + geography_id = "Country Code", + series_id = "Series Code", + counterpart_id = "Series Name", everything() ) |> tidyr::pivot_longer( - cols = -c(geography_id, series_id, counterpart_id), + cols = -c("geography_id", "series_id", "counterpart_id"), names_to = "year" ) |> - mutate(year = as.integer(year)) |> + mutate(year = as.integer(.data$year)) |> tidyr::drop_na() - cli::cli_inform("Deleting file.") + if (!quiet) { + cli::cli_inform("Deleting file.") + } + unlink(file_path) bulk } - diff --git a/R/ids_bulk_files.R b/R/ids_bulk_files.R index 30d5c36..1b2af4e 100644 --- a/R/ids_bulk_files.R +++ b/R/ids_bulk_files.R @@ -1,5 +1,28 @@ +#' Retrieve Available Bulk Download Files for International Debt Statistics +#' +#' This function returns a tibble with metadata for files available for bulk +#' download via the World Bank International Debt Statistics (IDS). It includes +#' information such as file names, URLs, and the last update dates for each file +#' in Excel (xlsx) format. +#' +#' @return A tibble containing the available files and their metadata: +#' \describe{ +#' \item{file_name}{The name of the file available for download.} +#' \item{file_url}{The URL to download the file in Excel format.} +#' \item{last_updated_date}{The date when the file was last updated.} +#' } +#' +#' @export +#' +#' @examplesIf curl::has_internet() +#' ids_bulk_files() +#' ids_bulk_files <- function() { + rlang::check_installed( + "jsonlite", reason = "to download bulk files." + ) + ids_meta <- jsonlite::fromJSON( txt = paste0( "https://datacatalogapi.worldbank.org/ddhxext/DatasetDownload", @@ -9,11 +32,11 @@ ids_bulk_files <- function() { bulk_files <- ids_meta$resources |> as_tibble() |> - select(name, distribution, last_updated_date) |> - unnest(distribution) |> - filter(distribution_format == "xlsx") |> - select(file_name = name, file_url = url, last_updated_date) |> - mutate(last_updated_date = as.Date(last_updated_date)) + select("name", "distribution", "last_updated_date") |> + unnest("distribution") |> + filter(.data$distribution_format == "xlsx") |> + select(file_name = "name", file_url = "url", "last_updated_date") |> + mutate(last_updated_date = as.Date(.data$last_updated_date)) bulk_files diff --git a/R/ids_bulk_series.R b/R/ids_bulk_series.R index 51d18f4..8da12ec 100644 --- a/R/ids_bulk_series.R +++ b/R/ids_bulk_series.R @@ -1,5 +1,33 @@ +#' Retrieve Bulk Series Metadata for International Debt Statistics +#' +#' This function retrieves a tibble with metadata for series available via +#' bulk download of the World Bank International Debt Statistics (IDS). +#' +#' @return A tibble containing the available series and their metadata: +#' \describe{ +#' \item{series_id}{The unique identifier for the series (e.g., +#' "BN.CAB.XOKA.CD").} +#' \item{series_name}{The name of the series (e.g., "Current account balance +#' (current US$)").} +#' \item{source_id}{The ID of the data source providing the indicator.} +#' \item{source_name}{The name or description of the source of the indicator +#' data.} +#' \item{source_note}{Additional notes or descriptions about the data source.} +#' \item{source_organization}{The organization responsible for the data +#' source.} +#' } +#' +#' @export +#' +#' @examplesIf curl::has_internet() +#' ids_bulk_series() +#' ids_bulk_series <- function() { + rlang::check_installed( + "jsonlite", reason = "to retrieve available series via bulk download." + ) + ids_meta <- jsonlite::fromJSON( txt = paste0( "https://datacatalogapi.worldbank.org/ddhxext/DatasetDownload", @@ -9,14 +37,14 @@ ids_bulk_series <- function() { bulk_series <- ids_meta$indicators |> as_tibble() |> - select(lineage) |> - unnest(lineage) |> - select(series_id = harvest_system_reference) + select("lineage") |> + unnest("lineage") |> + select(series_id = "harvest_system_reference") api_series <- ids_list_series() bulk_series <- bulk_series |> - inner_join(api_series, join_by(series_id)) + left_join(api_series, join_by("series_id")) bulk_series diff --git a/R/wbids-package.R b/R/wbids-package.R index 8d1fc3b..acc4bcd 100644 --- a/R/wbids-package.R +++ b/R/wbids-package.R @@ -6,7 +6,7 @@ ## usethis namespace: start #' @importFrom purrr map -#' @importFrom tidyr unnest unnest_wider crossing +#' @importFrom tidyr unnest unnest_wider crossing pivot_longer #' @importFrom rlang parse_expr eval_tidy ## usethis namespace: end NULL diff --git a/man/ids_bulk.Rd b/man/ids_bulk.Rd new file mode 100644 index 0000000..b796994 --- /dev/null +++ b/man/ids_bulk.Rd @@ -0,0 +1,44 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ids_bulk.R +\name{ids_bulk} +\alias{ids_bulk} +\title{Download and Process Bulk Data File for International Debt Statistics} +\usage{ +ids_bulk(file_url, file_path = tempfile(fileext = ".xlsx"), quiet = FALSE) +} +\arguments{ +\item{file_url}{A character string specifying the URL of the Excel file to +download. This parameter is required (see \link{ids_bulk_files}).} + +\item{file_path}{An optional character string specifying the file path where +the downloaded file will be saved. Defaults to a temporary file with \code{.xlsx} +extension. The file will automatically be deleted after processing.} + +\item{quiet}{A logical parameter indicating whether messages should be +printed to the console.} +} +\value{ +A tibble containing processed debt statistics data with the following +columns: +\describe{ +\item{geography_id}{The unique identifier for the geography (e.g., "ZMB").} +\item{series_id}{The unique identifier for the series (e.g., +"DT.DOD.DPPG.CD").} +\item{counterpart_id}{The unique identifier for the counterpart series.} +\item{year}{The year corresponding to the data (as an integer).} +\item{value}{The numeric value representing the statistic for the given +geography, series, counterpart, and year.} +} +} +\description{ +This function downloads a data file from the World Bank International Debt +Statistics (IDS), reads and processes the data into a tidy format. +} +\examples{ +\dontshow{if (curl::has_internet()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +available_files <- ids_bulk_files() +data <- ids_bulk( + available_files$file_url[1] +) +\dontshow{\}) # examplesIf} +} diff --git a/man/ids_bulk_files.Rd b/man/ids_bulk_files.Rd new file mode 100644 index 0000000..637d9ca --- /dev/null +++ b/man/ids_bulk_files.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ids_bulk_files.R +\name{ids_bulk_files} +\alias{ids_bulk_files} +\title{Retrieve Available Bulk Download Files for International Debt Statistics} +\usage{ +ids_bulk_files() +} +\value{ +A tibble containing the available files and their metadata: +\describe{ +\item{file_name}{The name of the file available for download.} +\item{file_url}{The URL to download the file in Excel format.} +\item{last_updated_date}{The date when the file was last updated.} +} +} +\description{ +This function returns a tibble with metadata for files available for bulk +download via the World Bank International Debt Statistics (IDS). It includes +information such as file names, URLs, and the last update dates for each file +in Excel (xlsx) format. +} +\examples{ +\dontshow{if (curl::has_internet()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +ids_bulk_files() +\dontshow{\}) # examplesIf} +} diff --git a/man/ids_bulk_series.Rd b/man/ids_bulk_series.Rd new file mode 100644 index 0000000..6c519e5 --- /dev/null +++ b/man/ids_bulk_series.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ids_bulk_series.R +\name{ids_bulk_series} +\alias{ids_bulk_series} +\title{Retrieve Bulk Series Metadata for International Debt Statistics} +\usage{ +ids_bulk_series() +} +\value{ +A tibble containing the available series and their metadata: +\describe{ +\item{series_id}{The unique identifier for the series (e.g., +"BN.CAB.XOKA.CD").} +\item{series_name}{The name of the series (e.g., "Current account balance +(current US$)").} +\item{source_id}{The ID of the data source providing the indicator.} +\item{source_name}{The name or description of the source of the indicator +data.} +\item{source_note}{Additional notes or descriptions about the data source.} +\item{source_organization}{The organization responsible for the data +source.} +} +} +\description{ +This function retrieves a tibble with metadata for series available via +bulk download of the World Bank International Debt Statistics (IDS). +} +\examples{ +\dontshow{if (curl::has_internet()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +ids_bulk_series() +\dontshow{\}) # examplesIf} +} From 66b087d461b5be68433d4a102d9c7cd4e278272f Mon Sep 17 00:00:00 2001 From: Christopher Carroll Smith Date: Tue, 5 Nov 2024 15:55:21 -0500 Subject: [PATCH 05/10] Mostly passing test suite, timeout handling, large file warning --- R/ids_bulk.R | 165 +++++++++++++--- R/ids_bulk_files.R | 2 +- R/ids_bulk_series.R | 2 +- tests/testthat/test-ids_bulk.R | 258 ++++++++++++++++++++++++++ tests/testthat/test-ids_get.R | 2 + tests/testthat/test-perform_request.R | 15 +- 6 files changed, 413 insertions(+), 31 deletions(-) create mode 100644 tests/testthat/test-ids_bulk.R diff --git a/R/ids_bulk.R b/R/ids_bulk.R index 44f1a8c..169aae7 100644 --- a/R/ids_bulk.R +++ b/R/ids_bulk.R @@ -10,6 +10,10 @@ #' extension. The file will automatically be deleted after processing. #' @param quiet A logical parameter indicating whether messages should be #' printed to the console. +#' @param timeout An integer specifying the timeout in seconds for downloading +#' the file. Defaults to the current R timeout setting. +#' @param warn_size A logical parameter indicating whether to warn about large +#' downloads. Defaults to TRUE. #' #' @return A tibble containing processed debt statistics data with the following #' columns: @@ -32,23 +36,122 @@ #' ) #' ids_bulk <- function( - file_url, file_path = tempfile(fileext = ".xlsx"), quiet = FALSE + file_url, + file_path = tempfile(fileext = ".xlsx"), + quiet = FALSE, + timeout = getOption("timeout", 60), + warn_size = TRUE ) { + rlang::check_installed("readxl", reason = "to download bulk files.") - rlang::check_installed( - "readxl", reason = "to download bulk files." - ) + # Download file with size checks and validation + download_bulk_file(file_url, file_path, timeout, warn_size, quiet) + + # Read and process the data + if (!quiet) message("Reading in file.") + bulk_data <- read_bulk_file(file_path) + + if (!quiet) message("Processing file.") + process_bulk_data(bulk_data) + + # Ensure cleanup even if processing fails + on.exit(unlink(file_path)) +} + +#' Get response headers from a URL +#' +#' @param file_url URL to request headers from +#' @return List of response headers +get_response_headers <- function(file_url) { + httr2::request(file_url) |> + httr2::req_headers("Accept" = "*/*") |> + httr2::req_perform() |> + httr2::resp_headers() +} - if (!quiet) { - cli::cli_inform("Downloading file to: {file_path}") +#' Download bulk data file with validation +#' +#' @param file_url URL of the file to download +#' @param file_path Path where file should be saved +#' @param timeout Timeout in seconds +#' @param warn_size Whether to warn about large files +#' @param quiet Whether to suppress messages +download_bulk_file <- function(file_url, file_path, timeout, warn_size, quiet) { + # Get file size before downloading + response_headers <- get_response_headers(file_url) + size_mb <- as.numeric(response_headers$`content-length`) / 1024^2 + formatted_size <- format(round(size_mb, 1), nsmall = 1) + + if (warn_size && size_mb > 100) { + warning( + sprintf( + paste( + "This file is %s MB and may take several minutes to download.", + "Current timeout setting: %s seconds.", + "Use warn_size=FALSE to disable this warning.", + sep = "\n" + ), + formatted_size, + timeout + ), + call. = FALSE + ) + + # Interactive confirmation + if (check_interactive()) { + response <- readline("Do you want to continue with the download? (y/N): ") + if (!tolower(response) %in% c("y", "yes")) { + stop("Download cancelled by user", call. = FALSE) + } + } } - utils::download.file(file_url, destfile = file_path, quiet = quiet) + # Print message about file download + if (!quiet) message("Downloading file to: {file_path}") + + # Download with timeout handling + withr::with_options( + list(timeout = timeout), + tryCatch({ + download_file(file_url, destfile = file_path, quiet = quiet) + }, + error = function(e) { + if (grepl("timeout|cannot open URL", e$message, ignore.case = TRUE)) { + stop( + paste0( + "Download timed out after ", timeout, " seconds.\n", + "Try increasing the timeout parameter", + " (e.g., timeout=600 for 10 minutes)" + ), + call. = FALSE + ) + } + stop(e$message, call. = FALSE) + }) + ) + + # Validate downloaded file + validate_file(file_path) +} - if (!quiet) { - cli::cli_inform("Reading in file.") +#' Validate that downloaded file exists and is not empty +#' +#' @param file_path Path to file to validate +validate_file <- function(file_path) { + if (!file.exists(file_path)) { + stop("Download failed: File not created") } + if (file.size(file_path) == 0) { + unlink(file_path) + stop("Download failed: Empty file") + } +} +#' Read bulk file and determine column types +#' +#' @param file_path Path to Excel file +#' @return Raw data frame from Excel file +read_bulk_file <- function(file_path) { available_columns <- readxl::read_excel(path = file_path, n_max = 0) |> colnames() relevant_columns <- tibble(names = available_columns) |> @@ -57,17 +160,19 @@ ids_bulk <- function( ) |> filter(!grepl("column", names, ignore.case = TRUE)) - bulk_raw <- readxl::read_excel( + readxl::read_excel( path = file_path, range = readxl::cell_cols(seq_len(nrow(relevant_columns))), col_types = relevant_columns$type ) +} - if (!quiet) { - cli::cli_inform("Processing file.") - } - - bulk <- bulk_raw |> +#' Process bulk data into tidy format +#' +#' @param bulk_raw Raw data frame from Excel file +#' @return Processed tibble in tidy format +process_bulk_data <- function(bulk_raw) { + bulk_raw |> select(-c("Country Name", "Classification Name")) |> select( geography_id = "Country Code", @@ -81,12 +186,28 @@ ids_bulk <- function( ) |> mutate(year = as.integer(.data$year)) |> tidyr::drop_na() +} - if (!quiet) { - cli::cli_inform("Deleting file.") - } - - unlink(file_path) - - bulk +#' Check if R is running interactively +#' +#' Wrapper around base::interactive() to make the function testable. +#' This function exists primarily to facilitate testing of interactive features. +#' +#' @return Logical indicating whether R is running interactively +#' @keywords internal +check_interactive <- function() { + interactive() } + +#' Download a file using utils::download.file +#' +#' Wrapper around utils::download.file to facilitate testing. +#' +#' @param url URL of file to download +#' @param destfile Destination file path +#' @param quiet Whether to suppress messages +#' @return Invisibly returns the status code from download.file +#' @keywords internal +download_file <- function(url, destfile, quiet) { + utils::download.file(url, destfile = destfile, quiet = quiet) +} \ No newline at end of file diff --git a/R/ids_bulk_files.R b/R/ids_bulk_files.R index 1b2af4e..9600dd0 100644 --- a/R/ids_bulk_files.R +++ b/R/ids_bulk_files.R @@ -33,7 +33,7 @@ ids_bulk_files <- function() { bulk_files <- ids_meta$resources |> as_tibble() |> select("name", "distribution", "last_updated_date") |> - unnest("distribution") |> + tidyr::unnest("distribution") |> filter(.data$distribution_format == "xlsx") |> select(file_name = "name", file_url = "url", "last_updated_date") |> mutate(last_updated_date = as.Date(.data$last_updated_date)) diff --git a/R/ids_bulk_series.R b/R/ids_bulk_series.R index 8da12ec..d8cf37f 100644 --- a/R/ids_bulk_series.R +++ b/R/ids_bulk_series.R @@ -38,7 +38,7 @@ ids_bulk_series <- function() { bulk_series <- ids_meta$indicators |> as_tibble() |> select("lineage") |> - unnest("lineage") |> + tidyr::unnest("lineage") |> select(series_id = "harvest_system_reference") api_series <- ids_list_series() diff --git a/tests/testthat/test-ids_bulk.R b/tests/testthat/test-ids_bulk.R new file mode 100644 index 0000000..6999c3d --- /dev/null +++ b/tests/testthat/test-ids_bulk.R @@ -0,0 +1,258 @@ +devtools::load_all() + +# Set timeout for testing +options(timeout = 60) + +test_that("ids_bulk handles custom file paths", { + skip_if_offline() + + test_url <- ids_bulk_files()$file_url[1] + temp_path <- tempfile(fileext = ".xlsx") + + local_mocked_bindings( + check_interactive = function() FALSE, + download_file = function(url, destfile, quiet) { + file.create(destfile) + }, + read_bulk_file = function(...) { + tibble::tibble() + }, + process_bulk_data = function(...) { + tibble::tibble() + } + ) + + # This acts like an expect statement to verify that the file exists at the + # destination path when we expect it to + local_mocked_bindings( + validate_file = function(...) file.exists(temp_path) + ) + + result <- ids_bulk( + test_url, file_path = temp_path, quiet = TRUE, warn_size = FALSE + ) + + # Check that file is cleaned up when we're done + expect_false(file.exists(temp_path)) +}) + +test_that("ids_bulk fails gracefully with invalid URL", { + expect_error( + ids_bulk("https://invalid-url.com/file.xlsx"), + "cannot open URL|download failed|Could not resolve host" + ) +}) + +test_that("ids_bulk requires readxl package", { + local_mocked_bindings( + check_installed = function(...) stop("Package not installed"), + .package = "rlang" + ) + expect_error( + ids_bulk("https://example.com/file.xlsx"), + "Package not installed" + ) +}) + +test_that("quiet parameter controls message output", { + test_url <- ids_bulk_files()$file_url[1] + + # Create a small mock dataset that read_excel would return + mock_data <- tibble::tibble( + "Country Code" = "ABC", + "Country Name" = "Test Country", + "Classification Name" = "Test Class", + "Series Code" = "TEST.1", + "Series Name" = "Test Series", + "2020" = 100 + ) + + # Set up mocked bindings + local_mocked_bindings( + download_file = function(...) TRUE + ) + local_mocked_bindings( + validate_file = function(...) TRUE + ) + local_mocked_bindings( + read_excel = function(...) mock_data, + .package = "readxl" + ) + local_mocked_bindings( + check_interactive = function() FALSE + ) + + # Should show messages + expect_message( + ids_bulk(test_url, quiet = FALSE, warn_size = FALSE), + "Downloading file" + ) + expect_message( + ids_bulk(test_url, quiet = FALSE, warn_size = FALSE), + "Reading in file" + ) + expect_message( + ids_bulk(test_url, quiet = FALSE, warn_size = FALSE), + "Processing file" + ) + + # Should not show messages + expect_no_message( + ids_bulk(test_url, quiet = TRUE, warn_size = FALSE) + ) +}) + +test_that("ids_bulk handles timeout parameter correctly", { + skip_if_offline() + skip_on_cran() + + # Mock a slow URL that will definitely timeout + mock_url <- "http://httpbin.org/delay/10" + + # Mock interactive to return FALSE + local_mocked_bindings( + check_interactive = function() FALSE + ) + + # Test with short timeout (1 second) + expect_warning( + expect_error( + ids_bulk(mock_url, timeout = 1, warn_size = FALSE), + "cannot open URL|Download timed out" + ), + "Timeout of 1 seconds was reached" + ) +}) + +test_that("ids_bulk handles warn_size parameter", { + skip_if_offline() + skip_on_cran() + + # Get a real file URL to test with + test_url <- ids_bulk_files()$file_url[1] + + # Mock download_file with mocked_bindings + local_mocked_bindings( + download_file = function(...) TRUE + ) + + # Mock validate_file with mocked_bindings + local_mocked_bindings( + validate_file = function(...) TRUE + ) + + # Mock interactive to return FALSE + local_mocked_bindings( + check_interactive = function() FALSE + ) + + # Should show warning with warn_size = TRUE + expect_warning( + download_bulk_file( + test_url, tempfile(), 60, warn_size = TRUE, quiet = TRUE + ), + "This file is 125.8 MB and may take several minutes to download", + fixed = FALSE + ) + + # Should not show warning with warn_size = FALSE + expect_no_warning( + download_bulk_file( + test_url, tempfile(), 60, warn_size = FALSE, quiet = TRUE + ) + ) +}) + +test_that("ids_bulk validates downloaded files", { + # Mock an empty file + temp_file <- tempfile() + file.create(temp_file) + + expect_error( + validate_file(temp_file), + "Download failed: Empty file" + ) + + # Mock a non-existent file + expect_error( + validate_file("nonexistent.xlsx"), + "Download failed: File not created" + ) +}) + +test_that("download_bulk_file downloads files correctly", { + skip_if_offline() + skip_on_cran() + + # Get a real file URL to test with + test_url <- ids_bulk_files()$file_url[1] + test_path <- tempfile(fileext = ".xlsx") + + # Mock interactive check to avoid prompts + local_mocked_bindings( + check_interactive = function() FALSE + ) + + # Test successful download + withr::with_options( + list(timeout = 300), + expect_no_error( + download_bulk_file( + test_url, + test_path, + timeout = 300, + warn_size = FALSE, + quiet = TRUE + ) + ) + ) + + # Verify file exists and has content + expect_true(file.exists(test_path)) + expect_gt(file.size(test_path), 0) + + # Clean up + unlink(test_path) +}) + +# Live, unmocked test +test_that("ids_bulk downloads and processes data correctly", { + skip_if_offline() + skip_on_cran() + + # Get a real file URL to test with + test_url <- ids_bulk_files()$file_url[1] + + local_mocked_bindings( + check_interactive = function() FALSE + ) + + # Add timeout to download + withr::with_options( + list(timeout = 300), + result <- ids_bulk(test_url, quiet = TRUE, warn_size = FALSE) + ) + + # Check structure + expect_s3_class(result, "tbl_df") + expect_named( + result, + c("geography_id", "series_id", "counterpart_id", "year", "value") + ) + + # Check data types + expect_type(result$geography_id, "character") + expect_type(result$series_id, "character") + expect_type(result$counterpart_id, "character") + expect_type(result$year, "integer") + expect_type(result$value, "double") + + # Check for non-empty result + expect_gt(nrow(result), 0) + + # Check that all values in required columns are non-NA + expect_false(any(is.na(result$geography_id))) + expect_false(any(is.na(result$series_id))) + expect_false(any(is.na(result$counterpart_id))) + expect_false(any(is.na(result$year))) +}) \ No newline at end of file diff --git a/tests/testthat/test-ids_get.R b/tests/testthat/test-ids_get.R index 8e2fe34..9830273 100644 --- a/tests/testthat/test-ids_get.R +++ b/tests/testthat/test-ids_get.R @@ -1,3 +1,5 @@ +devtools::load_all() + test_that("geographies input validation works", { expect_error( ids_get(geographies = NA, series = "DT.DOD.DPPG.CD", counterparts = "all") diff --git a/tests/testthat/test-perform_request.R b/tests/testthat/test-perform_request.R index d1fe87b..e1c3946 100644 --- a/tests/testthat/test-perform_request.R +++ b/tests/testthat/test-perform_request.R @@ -1,7 +1,8 @@ - -test_that("perform_request returns data for a series resource", { - resource <- "series" - result <- perform_request(resource) - expect_true(result[[1]]$name == "International Debt Statistics") - expect_true(result[[1]]$id == "6") -}) +devtools::load_all() + +test_that("perform_request returns data for a series resource", { + resource <- "series" + result <- perform_request(resource) + expect_true(result[[1]]$name == "International Debt Statistics") + expect_true(result[[1]]$id == "6") +}) From 80a705a2fc04279f5527435fc754e9d05b0bf4a9 Mon Sep 17 00:00:00 2001 From: Christopher Carroll Smith Date: Tue, 5 Nov 2024 16:08:36 -0500 Subject: [PATCH 06/10] Opt-out of interactive warning --- R/ids_bulk.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/ids_bulk.R b/R/ids_bulk.R index 169aae7..0d708b9 100644 --- a/R/ids_bulk.R +++ b/R/ids_bulk.R @@ -98,7 +98,7 @@ download_bulk_file <- function(file_url, file_path, timeout, warn_size, quiet) { ) # Interactive confirmation - if (check_interactive()) { + if (warn_size && check_interactive()) { response <- readline("Do you want to continue with the download? (y/N): ") if (!tolower(response) %in% c("y", "yes")) { stop("Download cancelled by user", call. = FALSE) From 0d14fb9434408c9b0b3b7c8123bc1c110ca2d9a0 Mon Sep 17 00:00:00 2001 From: Christopher Carroll Smith Date: Tue, 5 Nov 2024 21:29:21 -0500 Subject: [PATCH 07/10] Resolve devtools check warnings and don't run slow examples --- DESCRIPTION | 2 + NAMESPACE | 1 - R/ids_bulk.R | 12 +- man/check_interactive.Rd | 16 + man/download_bulk_file.Rd | 22 ++ man/download_file.Rd | 22 ++ man/get_response_headers.Rd | 17 + man/ids_bulk.Rd | 22 +- man/process_bulk_data.Rd | 17 + man/read_bulk_file.Rd | 17 + man/validate_file.Rd | 14 + renv.lock | 758 ++++++++++++++++++------------------ 12 files changed, 526 insertions(+), 394 deletions(-) create mode 100644 man/check_interactive.Rd create mode 100644 man/download_bulk_file.Rd create mode 100644 man/download_file.Rd create mode 100644 man/get_response_headers.Rd create mode 100644 man/process_bulk_data.Rd create mode 100644 man/read_bulk_file.Rd create mode 100644 man/validate_file.Rd diff --git a/DESCRIPTION b/DESCRIPTION index ddc8887..016b426 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -17,6 +17,7 @@ Depends: R (>= 4.1) Imports: cli, + withr, httr2 (>= 1.0.0), dplyr (>= 1.0.0), purrr (>= 1.0.0), @@ -24,6 +25,7 @@ Imports: rlang (>= 1.0.0) Suggests: curl, + tibble, devtools (>= 2.4.5), jsonlite (>= 1.0.0), lintr (>= 3.1.2), diff --git a/NAMESPACE b/NAMESPACE index 2a56817..05269bc 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,6 +1,5 @@ # Generated by roxygen2: do not edit by hand -export(ids_bulk) export(ids_bulk_files) export(ids_bulk_series) export(ids_get) diff --git a/R/ids_bulk.R b/R/ids_bulk.R index 0d708b9..d3820fd 100644 --- a/R/ids_bulk.R +++ b/R/ids_bulk.R @@ -28,8 +28,8 @@ #' } #' #' @export -#' -#' @examplesIf curl::has_internet() +#' @examples +#' \dontrun{ #' available_files <- ids_bulk_files() #' data <- ids_bulk( #' available_files$file_url[1] @@ -52,10 +52,12 @@ ids_bulk <- function( bulk_data <- read_bulk_file(file_path) if (!quiet) message("Processing file.") - process_bulk_data(bulk_data) + bulk_data <- process_bulk_data(bulk_data) # Ensure cleanup even if processing fails on.exit(unlink(file_path)) + + bulk_data } #' Get response headers from a URL @@ -209,5 +211,5 @@ check_interactive <- function() { #' @return Invisibly returns the status code from download.file #' @keywords internal download_file <- function(url, destfile, quiet) { - utils::download.file(url, destfile = destfile, quiet = quiet) -} \ No newline at end of file + utils::download.file(url, destfile = destfile, quiet = quiet, mode = "wb") +} diff --git a/man/check_interactive.Rd b/man/check_interactive.Rd new file mode 100644 index 0000000..b556cf4 --- /dev/null +++ b/man/check_interactive.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ids_bulk.R +\name{check_interactive} +\alias{check_interactive} +\title{Check if R is running interactively} +\usage{ +check_interactive() +} +\value{ +Logical indicating whether R is running interactively +} +\description{ +Wrapper around base::interactive() to make the function testable. +This function exists primarily to facilitate testing of interactive features. +} +\keyword{internal} diff --git a/man/download_bulk_file.Rd b/man/download_bulk_file.Rd new file mode 100644 index 0000000..2ae8c10 --- /dev/null +++ b/man/download_bulk_file.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ids_bulk.R +\name{download_bulk_file} +\alias{download_bulk_file} +\title{Download bulk data file with validation} +\usage{ +download_bulk_file(file_url, file_path, timeout, warn_size, quiet) +} +\arguments{ +\item{file_url}{URL of the file to download} + +\item{file_path}{Path where file should be saved} + +\item{timeout}{Timeout in seconds} + +\item{warn_size}{Whether to warn about large files} + +\item{quiet}{Whether to suppress messages} +} +\description{ +Download bulk data file with validation +} diff --git a/man/download_file.Rd b/man/download_file.Rd new file mode 100644 index 0000000..0f8c237 --- /dev/null +++ b/man/download_file.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ids_bulk.R +\name{download_file} +\alias{download_file} +\title{Download a file using utils::download.file} +\usage{ +download_file(url, destfile, quiet) +} +\arguments{ +\item{url}{URL of file to download} + +\item{destfile}{Destination file path} + +\item{quiet}{Whether to suppress messages} +} +\value{ +Invisibly returns the status code from download.file +} +\description{ +Wrapper around utils::download.file to facilitate testing. +} +\keyword{internal} diff --git a/man/get_response_headers.Rd b/man/get_response_headers.Rd new file mode 100644 index 0000000..8d9c9ab --- /dev/null +++ b/man/get_response_headers.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ids_bulk.R +\name{get_response_headers} +\alias{get_response_headers} +\title{Get response headers from a URL} +\usage{ +get_response_headers(file_url) +} +\arguments{ +\item{file_url}{URL to request headers from} +} +\value{ +List of response headers +} +\description{ +Get response headers from a URL +} diff --git a/man/ids_bulk.Rd b/man/ids_bulk.Rd index b796994..96c10d8 100644 --- a/man/ids_bulk.Rd +++ b/man/ids_bulk.Rd @@ -4,7 +4,13 @@ \alias{ids_bulk} \title{Download and Process Bulk Data File for International Debt Statistics} \usage{ -ids_bulk(file_url, file_path = tempfile(fileext = ".xlsx"), quiet = FALSE) +ids_bulk( + file_url, + file_path = tempfile(fileext = ".xlsx"), + quiet = FALSE, + timeout = getOption("timeout", 60), + warn_size = TRUE +) } \arguments{ \item{file_url}{A character string specifying the URL of the Excel file to @@ -16,6 +22,12 @@ extension. The file will automatically be deleted after processing.} \item{quiet}{A logical parameter indicating whether messages should be printed to the console.} + +\item{timeout}{An integer specifying the timeout in seconds for downloading +the file. Defaults to the current R timeout setting.} + +\item{warn_size}{A logical parameter indicating whether to warn about large +downloads. Defaults to TRUE.} } \value{ A tibble containing processed debt statistics data with the following @@ -34,11 +46,3 @@ geography, series, counterpart, and year.} This function downloads a data file from the World Bank International Debt Statistics (IDS), reads and processes the data into a tidy format. } -\examples{ -\dontshow{if (curl::has_internet()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} -available_files <- ids_bulk_files() -data <- ids_bulk( - available_files$file_url[1] -) -\dontshow{\}) # examplesIf} -} diff --git a/man/process_bulk_data.Rd b/man/process_bulk_data.Rd new file mode 100644 index 0000000..e394263 --- /dev/null +++ b/man/process_bulk_data.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ids_bulk.R +\name{process_bulk_data} +\alias{process_bulk_data} +\title{Process bulk data into tidy format} +\usage{ +process_bulk_data(bulk_raw) +} +\arguments{ +\item{bulk_raw}{Raw data frame from Excel file} +} +\value{ +Processed tibble in tidy format +} +\description{ +Process bulk data into tidy format +} diff --git a/man/read_bulk_file.Rd b/man/read_bulk_file.Rd new file mode 100644 index 0000000..b32d831 --- /dev/null +++ b/man/read_bulk_file.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ids_bulk.R +\name{read_bulk_file} +\alias{read_bulk_file} +\title{Read bulk file and determine column types} +\usage{ +read_bulk_file(file_path) +} +\arguments{ +\item{file_path}{Path to Excel file} +} +\value{ +Raw data frame from Excel file +} +\description{ +Read bulk file and determine column types +} diff --git a/man/validate_file.Rd b/man/validate_file.Rd new file mode 100644 index 0000000..d7bd64f --- /dev/null +++ b/man/validate_file.Rd @@ -0,0 +1,14 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ids_bulk.R +\name{validate_file} +\alias{validate_file} +\title{Validate that downloaded file exists and is not empty} +\usage{ +validate_file(file_path) +} +\arguments{ +\item{file_path}{Path to file to validate} +} +\description{ +Validate that downloaded file exists and is not empty +} diff --git a/renv.lock b/renv.lock index 65fb496..f9d12ef 100644 --- a/renv.lock +++ b/renv.lock @@ -1,379 +1,379 @@ -{ - "R": { - "Version": "4.4.1", - "Repositories": [ - { - "Name": "CRAN", - "URL": "https://lib.stat.cmu.edu/R/CRAN" - } - ] - }, - "Packages": { - "R6": { - "Package": "R6", - "Version": "2.5.1", - "Source": "Repository", - "Repository": "CRAN", - "Requirements": [ - "R" - ], - "Hash": "470851b6d5d0ac559e9d01bb352b4021" - }, - "askpass": { - "Package": "askpass", - "Version": "1.2.1", - "Source": "Repository", - "Repository": "CRAN", - "Requirements": [ - "sys" - ], - "Hash": "c39f4155b3ceb1a9a2799d700fbd4b6a" - }, - "cli": { - "Package": "cli", - "Version": "3.6.3", - "Source": "Repository", - "Repository": "CRAN", - "Requirements": [ - "R", - "utils" - ], - "Hash": "b21916dd77a27642b447374a5d30ecf3" - }, - "cpp11": { - "Package": "cpp11", - "Version": "0.5.0", - "Source": "Repository", - "Repository": "CRAN", - "Requirements": [ - "R" - ], - "Hash": "91570bba75d0c9d3f1040c835cee8fba" - }, - "curl": { - "Package": "curl", - "Version": "5.2.3", - "Source": "Repository", - "Repository": "CRAN", - "Requirements": [ - "R" - ], - "Hash": "d91263322a58af798f6cf3b13fd56dde" - }, - "dplyr": { - "Package": "dplyr", - "Version": "1.1.4", - "Source": "Repository", - "Repository": "CRAN", - "Requirements": [ - "R", - "R6", - "cli", - "generics", - "glue", - "lifecycle", - "magrittr", - "methods", - "pillar", - "rlang", - "tibble", - "tidyselect", - "utils", - "vctrs" - ], - "Hash": "fedd9d00c2944ff00a0e2696ccf048ec" - }, - "fansi": { - "Package": "fansi", - "Version": "1.0.6", - "Source": "Repository", - "Repository": "CRAN", - "Requirements": [ - "R", - "grDevices", - "utils" - ], - "Hash": "962174cf2aeb5b9eea581522286a911f" - }, - "generics": { - "Package": "generics", - "Version": "0.1.3", - "Source": "Repository", - "Repository": "CRAN", - "Requirements": [ - "R", - "methods" - ], - "Hash": "15e9634c0fcd294799e9b2e929ed1b86" - }, - "glue": { - "Package": "glue", - "Version": "1.8.0", - "Source": "Repository", - "Repository": "CRAN", - "Requirements": [ - "R", - "methods" - ], - "Hash": "5899f1eaa825580172bb56c08266f37c" - }, - "httr2": { - "Package": "httr2", - "Version": "1.0.5", - "Source": "Repository", - "Repository": "CRAN", - "Requirements": [ - "R", - "R6", - "cli", - "curl", - "glue", - "lifecycle", - "magrittr", - "openssl", - "rappdirs", - "rlang", - "vctrs", - "withr" - ], - "Hash": "d84e4c33206aaace37714901ac2b00c3" - }, - "lifecycle": { - "Package": "lifecycle", - "Version": "1.0.4", - "Source": "Repository", - "Repository": "CRAN", - "Requirements": [ - "R", - "cli", - "glue", - "rlang" - ], - "Hash": "b8552d117e1b808b09a832f589b79035" - }, - "magrittr": { - "Package": "magrittr", - "Version": "2.0.3", - "Source": "Repository", - "Repository": "CRAN", - "Requirements": [ - "R" - ], - "Hash": "7ce2733a9826b3aeb1775d56fd305472" - }, - "openssl": { - "Package": "openssl", - "Version": "2.2.2", - "Source": "Repository", - "Repository": "CRAN", - "Requirements": [ - "askpass" - ], - "Hash": "d413e0fef796c9401a4419485f709ca1" - }, - "pillar": { - "Package": "pillar", - "Version": "1.9.0", - "Source": "Repository", - "Repository": "CRAN", - "Requirements": [ - "cli", - "fansi", - "glue", - "lifecycle", - "rlang", - "utf8", - "utils", - "vctrs" - ], - "Hash": "15da5a8412f317beeee6175fbc76f4bb" - }, - "pkgconfig": { - "Package": "pkgconfig", - "Version": "2.0.3", - "Source": "Repository", - "Repository": "CRAN", - "Requirements": [ - "utils" - ], - "Hash": "01f28d4278f15c76cddbea05899c5d6f" - }, - "purrr": { - "Package": "purrr", - "Version": "1.0.2", - "Source": "Repository", - "Repository": "CRAN", - "Requirements": [ - "R", - "cli", - "lifecycle", - "magrittr", - "rlang", - "vctrs" - ], - "Hash": "1cba04a4e9414bdefc9dcaa99649a8dc" - }, - "rappdirs": { - "Package": "rappdirs", - "Version": "0.3.3", - "Source": "Repository", - "Repository": "CRAN", - "Requirements": [ - "R" - ], - "Hash": "5e3c5dc0b071b21fa128676560dbe94d" - }, - "renv": { - "Package": "renv", - "Version": "1.0.11", - "Source": "Repository", - "Repository": "CRAN", - "Requirements": [ - "utils" - ], - "Hash": "47623f66b4e80b3b0587bc5d7b309888" - }, - "rlang": { - "Package": "rlang", - "Version": "1.1.4", - "Source": "Repository", - "Repository": "CRAN", - "Requirements": [ - "R", - "utils" - ], - "Hash": "3eec01f8b1dee337674b2e34ab1f9bc1" - }, - "stringi": { - "Package": "stringi", - "Version": "1.8.4", - "Source": "Repository", - "Repository": "CRAN", - "Requirements": [ - "R", - "stats", - "tools", - "utils" - ], - "Hash": "39e1144fd75428983dc3f63aa53dfa91" - }, - "stringr": { - "Package": "stringr", - "Version": "1.5.1", - "Source": "Repository", - "Repository": "CRAN", - "Requirements": [ - "R", - "cli", - "glue", - "lifecycle", - "magrittr", - "rlang", - "stringi", - "vctrs" - ], - "Hash": "960e2ae9e09656611e0b8214ad543207" - }, - "sys": { - "Package": "sys", - "Version": "3.4.3", - "Source": "Repository", - "Repository": "CRAN", - "Hash": "de342ebfebdbf40477d0758d05426646" - }, - "tibble": { - "Package": "tibble", - "Version": "3.2.1", - "Source": "Repository", - "Repository": "CRAN", - "Requirements": [ - "R", - "fansi", - "lifecycle", - "magrittr", - "methods", - "pillar", - "pkgconfig", - "rlang", - "utils", - "vctrs" - ], - "Hash": "a84e2cc86d07289b3b6f5069df7a004c" - }, - "tidyr": { - "Package": "tidyr", - "Version": "1.3.1", - "Source": "Repository", - "Repository": "CRAN", - "Requirements": [ - "R", - "cli", - "cpp11", - "dplyr", - "glue", - "lifecycle", - "magrittr", - "purrr", - "rlang", - "stringr", - "tibble", - "tidyselect", - "utils", - "vctrs" - ], - "Hash": "915fb7ce036c22a6a33b5a8adb712eb1" - }, - "tidyselect": { - "Package": "tidyselect", - "Version": "1.2.1", - "Source": "Repository", - "Repository": "CRAN", - "Requirements": [ - "R", - "cli", - "glue", - "lifecycle", - "rlang", - "vctrs", - "withr" - ], - "Hash": "829f27b9c4919c16b593794a6344d6c0" - }, - "utf8": { - "Package": "utf8", - "Version": "1.2.4", - "Source": "Repository", - "Repository": "CRAN", - "Requirements": [ - "R" - ], - "Hash": "62b65c52671e6665f803ff02954446e9" - }, - "vctrs": { - "Package": "vctrs", - "Version": "0.6.5", - "Source": "Repository", - "Repository": "CRAN", - "Requirements": [ - "R", - "cli", - "glue", - "lifecycle", - "rlang" - ], - "Hash": "c03fa420630029418f7e6da3667aac4a" - }, - "withr": { - "Package": "withr", - "Version": "3.0.1", - "Source": "Repository", - "Repository": "CRAN", - "Requirements": [ - "R", - "grDevices", - "graphics" - ], - "Hash": "07909200e8bbe90426fbfeb73e1e27aa" - } - } -} +{ + "R": { + "Version": "4.4.1", + "Repositories": [ + { + "Name": "CRAN", + "URL": "https://lib.stat.cmu.edu/R/CRAN" + } + ] + }, + "Packages": { + "R6": { + "Package": "R6", + "Version": "2.5.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "470851b6d5d0ac559e9d01bb352b4021" + }, + "askpass": { + "Package": "askpass", + "Version": "1.2.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "sys" + ], + "Hash": "c39f4155b3ceb1a9a2799d700fbd4b6a" + }, + "cli": { + "Package": "cli", + "Version": "3.6.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "utils" + ], + "Hash": "b21916dd77a27642b447374a5d30ecf3" + }, + "cpp11": { + "Package": "cpp11", + "Version": "0.5.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "91570bba75d0c9d3f1040c835cee8fba" + }, + "curl": { + "Package": "curl", + "Version": "5.2.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "d91263322a58af798f6cf3b13fd56dde" + }, + "dplyr": { + "Package": "dplyr", + "Version": "1.1.4", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "R6", + "cli", + "generics", + "glue", + "lifecycle", + "magrittr", + "methods", + "pillar", + "rlang", + "tibble", + "tidyselect", + "utils", + "vctrs" + ], + "Hash": "fedd9d00c2944ff00a0e2696ccf048ec" + }, + "fansi": { + "Package": "fansi", + "Version": "1.0.6", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "grDevices", + "utils" + ], + "Hash": "962174cf2aeb5b9eea581522286a911f" + }, + "generics": { + "Package": "generics", + "Version": "0.1.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "methods" + ], + "Hash": "15e9634c0fcd294799e9b2e929ed1b86" + }, + "glue": { + "Package": "glue", + "Version": "1.8.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "methods" + ], + "Hash": "5899f1eaa825580172bb56c08266f37c" + }, + "httr2": { + "Package": "httr2", + "Version": "1.0.6", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "R6", + "cli", + "curl", + "glue", + "lifecycle", + "magrittr", + "openssl", + "rappdirs", + "rlang", + "vctrs", + "withr" + ], + "Hash": "3ef5d07ec78803475a94367d71b40c41" + }, + "lifecycle": { + "Package": "lifecycle", + "Version": "1.0.4", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cli", + "glue", + "rlang" + ], + "Hash": "b8552d117e1b808b09a832f589b79035" + }, + "magrittr": { + "Package": "magrittr", + "Version": "2.0.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "7ce2733a9826b3aeb1775d56fd305472" + }, + "openssl": { + "Package": "openssl", + "Version": "2.2.2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "askpass" + ], + "Hash": "d413e0fef796c9401a4419485f709ca1" + }, + "pillar": { + "Package": "pillar", + "Version": "1.9.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "cli", + "fansi", + "glue", + "lifecycle", + "rlang", + "utf8", + "utils", + "vctrs" + ], + "Hash": "15da5a8412f317beeee6175fbc76f4bb" + }, + "pkgconfig": { + "Package": "pkgconfig", + "Version": "2.0.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "utils" + ], + "Hash": "01f28d4278f15c76cddbea05899c5d6f" + }, + "purrr": { + "Package": "purrr", + "Version": "1.0.2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cli", + "lifecycle", + "magrittr", + "rlang", + "vctrs" + ], + "Hash": "1cba04a4e9414bdefc9dcaa99649a8dc" + }, + "rappdirs": { + "Package": "rappdirs", + "Version": "0.3.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "5e3c5dc0b071b21fa128676560dbe94d" + }, + "renv": { + "Package": "renv", + "Version": "1.0.11", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "utils" + ], + "Hash": "47623f66b4e80b3b0587bc5d7b309888" + }, + "rlang": { + "Package": "rlang", + "Version": "1.1.4", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "utils" + ], + "Hash": "3eec01f8b1dee337674b2e34ab1f9bc1" + }, + "stringi": { + "Package": "stringi", + "Version": "1.8.4", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "stats", + "tools", + "utils" + ], + "Hash": "39e1144fd75428983dc3f63aa53dfa91" + }, + "stringr": { + "Package": "stringr", + "Version": "1.5.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cli", + "glue", + "lifecycle", + "magrittr", + "rlang", + "stringi", + "vctrs" + ], + "Hash": "960e2ae9e09656611e0b8214ad543207" + }, + "sys": { + "Package": "sys", + "Version": "3.4.3", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "de342ebfebdbf40477d0758d05426646" + }, + "tibble": { + "Package": "tibble", + "Version": "3.2.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "fansi", + "lifecycle", + "magrittr", + "methods", + "pillar", + "pkgconfig", + "rlang", + "utils", + "vctrs" + ], + "Hash": "a84e2cc86d07289b3b6f5069df7a004c" + }, + "tidyr": { + "Package": "tidyr", + "Version": "1.3.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cli", + "cpp11", + "dplyr", + "glue", + "lifecycle", + "magrittr", + "purrr", + "rlang", + "stringr", + "tibble", + "tidyselect", + "utils", + "vctrs" + ], + "Hash": "915fb7ce036c22a6a33b5a8adb712eb1" + }, + "tidyselect": { + "Package": "tidyselect", + "Version": "1.2.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cli", + "glue", + "lifecycle", + "rlang", + "vctrs", + "withr" + ], + "Hash": "829f27b9c4919c16b593794a6344d6c0" + }, + "utf8": { + "Package": "utf8", + "Version": "1.2.4", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "62b65c52671e6665f803ff02954446e9" + }, + "vctrs": { + "Package": "vctrs", + "Version": "0.6.5", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cli", + "glue", + "lifecycle", + "rlang" + ], + "Hash": "c03fa420630029418f7e6da3667aac4a" + }, + "withr": { + "Package": "withr", + "Version": "3.0.2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "grDevices", + "graphics" + ], + "Hash": "cc2d62c76458d425210d1eb1478b30b4" + } + } +} From 5707a82462069f5126b27b8731822c26d60b7583 Mon Sep 17 00:00:00 2001 From: Christopher Carroll Smith Date: Tue, 5 Nov 2024 22:27:58 -0500 Subject: [PATCH 08/10] Add sample data, repair missing curly brace --- NAMESPACE | 1 + R/ids_bulk.R | 10 +++--- tests/testthat/data/sample.rds | Bin 0 -> 613 bytes tests/testthat/data/sample.xlsx | Bin 0 -> 90841 bytes tests/testthat/test-ids_bulk.R | 48 +++++++++++++++++--------- tests/testthat/test-ids_get.R | 2 -- tests/testthat/test-perform_request.R | 2 -- 7 files changed, 38 insertions(+), 25 deletions(-) create mode 100644 tests/testthat/data/sample.rds create mode 100644 tests/testthat/data/sample.xlsx diff --git a/NAMESPACE b/NAMESPACE index 05269bc..2a56817 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,6 @@ # Generated by roxygen2: do not edit by hand +export(ids_bulk) export(ids_bulk_files) export(ids_bulk_series) export(ids_get) diff --git a/R/ids_bulk.R b/R/ids_bulk.R index d3820fd..5ca2dd5 100644 --- a/R/ids_bulk.R +++ b/R/ids_bulk.R @@ -34,6 +34,7 @@ #' data <- ids_bulk( #' available_files$file_url[1] #' ) +#' } #' ids_bulk <- function( file_url, @@ -44,6 +45,9 @@ ids_bulk <- function( ) { rlang::check_installed("readxl", reason = "to download bulk files.") + # Register cleanup immediately after creating temporary file + on.exit(unlink(file_path)) + # Download file with size checks and validation download_bulk_file(file_url, file_path, timeout, warn_size, quiet) @@ -54,10 +58,8 @@ ids_bulk <- function( if (!quiet) message("Processing file.") bulk_data <- process_bulk_data(bulk_data) - # Ensure cleanup even if processing fails - on.exit(unlink(file_path)) - - bulk_data + # Return the processed data + return(bulk_data) } #' Get response headers from a URL diff --git a/tests/testthat/data/sample.rds b/tests/testthat/data/sample.rds new file mode 100644 index 0000000000000000000000000000000000000000..704ba01a59311924b58f6652ed3a5ae4ef85a256 GIT binary patch literal 613 zcmb2|=3oE=wzsna^DhO69Dnb2F(>$OoBRR&gv-^E1@Dz}bq)J2dYJB;Y31OV=DFb5 zo6I^f`}zEJOdrd(eaL^A{8-CU{pFA1TXXNfpEBX?!uS1>$-HS2>}xJwnP_^S?H>2a zYTdubt{o4qwMk~P_R@P(-Tb%vr>y_4&HnQbXYA`b+!6JEmFxV2f46hp|GMtQoA@*D ze;ncU`F{0=OdLz!%N?!jtUn#U{Vwy?*2&rI&3A?OCGR);Xuiqv-|TY7lV7H%UatLp z>8x*lZd=cvluHY8_VM2}zN5MQ;LWt=x(W7^eWfbnHdOzeTmN#egxcg&Y&*ppx8L4c zy#1%i_Q=lXcX@U1ChXYk$i4ks-efg(`EPI6KjFW9SiZDY)&J9)X8y`a>R^;ETXSNv z%}FqN{lIzN6HhRTWS?LAG3BfNr#0J7Y`&#*KC9biwJtJe?f+N*fByca;QvX*|I?i+ zsdg)wCH-7x>(?E=+V!_qXv;)1`6Ke{?S0a2E?)F2R;ph;QD)ZW)E}u)Gm5vw)EFz@ z^-r_CcKl)a-{ie<|8KEZmz?g`ZsR8zK|721Ibxptt#tiz(yQXQX7 qV0~itr1*sFiP#giCxna&EU`e=0!(;&THW8j?7HW&j_x*MU;qFmN;5J5 literal 0 HcmV?d00001 diff --git a/tests/testthat/data/sample.xlsx b/tests/testthat/data/sample.xlsx new file mode 100644 index 0000000000000000000000000000000000000000..13ca2b89ba46217cbc62e07ec3975d548af7f317 GIT binary patch literal 90841 zcmd>nc|eU@)V?vU%u@&v6^RrY40R)JN~SVIL{z5c2vNwCSsJ90sY}<8iUz4rq(PZO z^PmhV6)Fwqx1Qbo3|*z^9KP@OhrDNSe`8BziqoriG8Qr zTSmPf+v{zP2&rWUwhZ;NZ_g4*Vo^_<)-U@%aEfTU;5*yUJ3wbIpnsj>R_O=T1 z{yEfVa;fY+JCw^?NNwbn5ydI(3U-s+EGv@(!21R6qQE?1H`MtCj7# z=sn$=Iiij3&VPLS_(u9h4R7({Prhkg{6q%(UXI`7aB9`+51BCbEcRj4qj$EYjMx^Pfx{Ih%`Y#${7$@&UPbTn>HB;aUh?>C za43W`VpncTL5bkZ@20!ZW9p07G|g%)nlmt)|g9Zb>Z2xEerpZ}l z$Bb0kp7abJa3)!Fw8D+SMuJ!OpN_E2%eOo9XZ!st+Z-^>%`u31dvE;yH~VLQ>f2u8 ze4p;EW8!wj-H54NY1&DgpKsToHqs_%+Ph}!S4J=4oP^*W^UA~QnOHQoypP+tp z*n#fRGh$Xw92)=l_3m{y4t)6MQohCKs4dysz5L_;d~r?WT!qxbF>8z#8oxgLZt1B3 z1`Eoghb*7g&u;66$N6qM=VhN1pLsuL(cFaK@(E{;tK2_%!ryI07Y(oJ88HjO*7i+Y z^hZwoKDCJfoS?qPc5EADsrARQa_NU+viCPN`+i1VDhr-|LNg&jGt!6tU%y7OYEmqX z%~tCg8?VMCST#Y13=t}0g4#^A-n<(BRN0Yk10 z+r9pMck4e&3zg=+&AfkJXiw6HvnTJG&CI&sJvL#*v;0tno+sw-J3lSI-^yNgOBYR_ zyYS8aGyRN$Z-^`PUAXg)V>b7Ig4y_2h+AH4kZr2{~ePTbj zOWUt|JtM2HU{Vc~`-nV(3gF# zsQ4s1xa*zPc`A{w+IBsdt-sZ-v8K)>9%(^HnwDLnyv0~->UB;a_?_vT{ zH&vw1P^>I16RP~!DK$>xvrc}hby1OIYQ_7U{L0Unopdt&591D&M_L4J|7Tt0>9Wv02ZF*0C;sZJb(B zSm~iy@iyPOve+Zkx;V$C|K~&<8_V*-m!E^fHWycPO0E3dqw=L#(HQIU7@bhgqlA)3 z#fl1J9h;Ju36h1662h#DW6C5s)Ny61P35P9VVt7ke4Vn$)OcCN%@r|1p&dGMd_4;a z-oMMQEGe_8jB?HotBj22cyKE3(O?c1ywwS-eC_OQW6c><^2ybvJfz~FkWIMQPyG+om$drt)>ZBBwAj)w-e`r=+D#d4)%1!P}dhQpM|>SH+6uAIpS74}_I} zsC<&2YV%O1vR6e(v5|VVq>i{IGL2a^8SL%q1OZ-MQT{cW*V{JzJ27?CV78axLSq6 z6z4%D@0G(2K6uww;rhM&Wfl{*b@DDK>y>;kEqq+L!W4nQB_%BsU+ruqWs!PI~XOY5mUBNc^{}>c8Dp|Jhajx2NjAy_^DL3ya+FW#tMx z1G2(bSN&&R^`F(Iac3f4|IM)$I=!%~^?JwD$X8C= zg%-aombxaAzH46T=6yy}OVZ~kSj#^g{)giAXc~;#txn#BG#LB$;pb^E0fWomi_=)Y zzJ1WUu#0h2)b%ObtF$1L?^^{XeE2cxbpsVSH{_NJk6TQ=JZ$(Hk=KMoH>{ z48zaw?{e04H-5BhS7pHI^{xuzKZW(Xo%kXBCWpEe{rGCos>4(_oIi|@Z2UZ9z3bydn_G!z`g6Jw`m@J-8LtG+_JFA&m15V_eKuCiuyEBS z^J|&gZ$2tMGTigzt&vk!g* zuB*TK7?x%@+ndvxx~!0-F5lYROgyug!;da?-pd5pyo>zyH8tIXrt?_S3^eV5rrs8= zU8%uq84>dM&`_29cqTfWOW>#m44vi8aWv96wb-V;yWPeLpLL>dK1OD_oJ$Z2HX!3Z z4;Z(=*!~z97p?&E6pVXd91UX`jQh^O=m4WOjIJv))(Ihw$c=c}Z53g1&k;uI@4v}- z;@Ce4LZ?^#L*CANk?|6YH((sJ8pew-`oow;M$VQeW9Gzjnm=0oPYS2yrv%OBCO6u; ziZ|~#UsofbblCxQ$L4L;_ugx&EGE$>bNCyefGp=moi<3HJ3YRFrsyu!ttPxDU^zkL4X`r6nol6uHoztVb`r1$fW0D^!3Tnk+eom1fY}443YaHg zj{tiOZ-7|=rW9f_BJI>-IRTT|k`$YlKwRs}&B}$YyIw8s5!c%734czDyf-_{oA3H~ zD`-p1#&qo)E78IqEws_%618wk0PHQn+I%7yzZJpk0J{U&a=?56dk$DGyaA>Lm{*9! zh_t7R#|oINk)$yFoe7qxMzD9DX6d`Fth}`4GEx>t=MVF=nsd!q;&w=gMXJ^wE34O` zSGyN~dbrtmC?U(TXD2196(@TJ1~}&>s+k%~CKo$Xvunm9se$H*zGQLa|BEm$Z*?jD zG&{&7qIR>l1JJ`5T9u(^!^yv9MCWMUy!cZzO`_FH?HeH>W+T#47DuI;Z7Hs1qmypz zP2&%k7uT9R*3|R|u&e0d1$uag9@e1;I-ADcG)(~s@U|M>egun2-M6z?wbE$xb=GT* zxLVz1qE}PuHHFThv9TL}`G&>lRS>=IM{su#+<#z!0kYr2rc^5ERRvO?rWet}+#r)% zAt7@{xKRL({9;Lo3t!&)qw(hApvi#&0eRgd$nDF&=BI_2c`V&(W%X7eqDAqirv9kB0TNE-CDanSm+)`o|qp6Nkyq z!8xLvOG*kZpnP0smYDo;Xwby4^0aYPXVD7ILl8p>V#wD{^EgkR7wky}Z@C_|xJblRF`sXO3_)H5PJ!xlQrObAbV!@-$|VB`NY$Mv6jU z{N&pqn@xoF?XfCLQ|R5J_|whJqs8;y*_N%*M1yoRh~6=ZEN1EZtjbPk%Vnl03=xR? z-kfGFP2;Q`LZjYHx49Grd_;sW>Vp{dUznlOn4wwL+A_)KAK+?v1u)(0QWWTB_d{?a zVKdOR7`i@!uA|Ut7CObvNdXs#N7jtlC#=S>LtHC$Xi*PXJo-04|9t1UJCIxs6Bt46 zqIdBBkNFhLp+jJnWahmLU1xLI>($hJsI}g|sz}^717BE~9b$~^C z#M-ehn0htE{UH>yoQjiaj6h@&h${lQhd}5VC1i8GVOgCF@33#b+M6b$2YS*7*^K)` zC@z6i%t$^0u|y!j2&4`$vvm4IU(ycDNC_P#aEUxb?-)j{>u3&h;GdV2sKeSwzPv@Z z1!vY$Ey(0{NQEcdR?Z%wZE9>Y6wd1o$JE-?`%kA9ZCZBBQ%YNYx)o8-BLY{>wV`Dty1T21HIPPe^bx^>j1 z&T^6_y9mtJu|O#;;)aMqTlZdax7(cT)-s@EfQ4>aFQM(z+iPdq-nZLozNzzADU*Yp zCW`TOEL3_Gabq$AM*%Eb3h)pHehIK213NQt5x{y3e2;l%U^xcP0l0{PJs9`{z&jZD z0rUKMfSGQZijXpe@!IyT-PTc?JIhO%ob4n`VSH4|in!sau-mPd+>|ikRL$smS)3-Bw!$e!#$=37n>`xK8)|-$LW0 z);~Jv-s}47$m#7$j6ls1Xb=KTLZEq=L`#eZCpaFHnA0HGEqF^OZ(%0nO$XP3 zBxXkd-uTh!4s^;bm<2k;bs&i$IHOZFbn1ytA0oEbh>c4yZ;W&vIvs{i9lK^yhn^AZ zDW;)P{pl^$eQkJbPGDVLWszKDk>CV-V|Ee{=xPLd6|?gKv-1wKgAck+lfiI5NX2zv zjMl`x6_<-K7htOU!Ug(&^w_hn zc;)qFGxYA1jb7|~c4Fq{KE}^Ayb2WdC**oPTkmnl>XW9?^%RutR?pCjOy`d;o3SIZY;@`vPxkjV`}>mpZG9JZ5%za7`>V(P?qGjC@22y2 zs+e(`y?Dv~wvJ*A*x$+Q@5(>oE8MSaFRq-v;Fhh8*zok*VMmH zC`|3h6abSCOv7Q~CsQ#@H(`>3sXctzlIa0VV_@n4U$!^3%+icT%Bgis>cD3ZwKe!= znuNTGY%e#FHhFxf{jzQ(FR^gy8z{Ih&c3Ck?E?lL3-A;Me#OAowEj%{>JO@K`#1Jv5b1}r4O!NVjeTIpU0ZJVWd1YFM9v7iU`hdzlL#VtmrHKqr zH+qk2fBjUoK*8&nfW;5H=J81)Cg&^LgKw%)U^T-GqU?fi#%P&k7`-=haw89JB4X6K zzUDuIm3qmkO@G$m)(tJQTSlGv;_SPvvmI&Tujv)|!R1>x*t1Nt2f=d*Cw?9}nlUBrOSWUhq#GTFAv z45E6|$seZ{N3;7(%j}L(=R0xsqv+(Xb8_<$-0tI-wU0(yTa#>~&eS}qgRVi8ORy5T zHJ9B@_&h#4zpU8g0j5rFL4t$Hr=@L#mRYvZAvu7%GBDki%w<*FzJhT-RKcg9D?R|q zbnOploC%-i+3=+aU$_^k@X9m|J>n*I7Xy+;5Ii$sjArOj8$sZ{c9)q9qILu;|c_JWqSaav}XM)&2_jFLKxftdXS_N>Dx z#*5m4Ml|5iK_pTV4Ydjt?pdnW`>$E~w&Vfr97OUTZAz&AcYVS{J(B2BuFfR4`z?oS zI+0Geh~JUG-@H}jp_=gvzG#sKwJKV4#A%7_?uje^SZ6!Lp=l05fdYIkeFB&nAicv#1025r9Y=g9#KIO`@Kq?H!1P#Kfi(?cxa- zpADYUt?vmQH~3XO*xD-$e=I(gU)fKSo0yiC11*g>9tm&6@nXU8+=2u@FySo)!rOhO z(rskmd3jX3@CAllJtnS z&11AJ8nmruFp0keX8K<+^uHw}{ssx=GSA7(GZPEfG0(Mu8%5n}&S>F$HJ)G9nnt6C z^_F;Umpg>#_TS-f5(|e>q&gmw;B#3p;-p{J&g20dN$JbwGbNp8sqF4a22mY?mHLiV zGkVq`*WB+htvxRMAXZms$NJnq+af_UjC};g~TNa?B6C} zw;3!+cA)7GS+?r{5?>iSJgiQ;7!#|NcHxfob8^;TR82W8CioHKic21_7J?r!E>Z^{ zL-0Gq)Ip+W?x1HR_z^uLb+9SGOiGkyp6Rw^E_;_ri7qS*UgW}XQ#Qjrgr~HN_4t)` z;lZOC6XUW8!&Zfcr}P>c-Vi4E5#zd{_ zFQ8qx;uz7x$9M(C*as$Vr@6GuJ`=f|#k4jkZkdZ#S4naUswBL*Ov1Z3r?$7;LMh^J zTBVLb+q(XJO%Ispr4|(u{P#=ZjYk==DyT z1JmnBeKGlsm>y-h^r-BQigC=q^r({W8?Xce*Re*huHc67 zvYLtk>yZYlCkgw~<1eZ;l)?FL5OZQBeR&Y}h`dpaACb2RkTTfZk_F55HXb&AVI&yA&8jDL>A8PaENS|iZBbOwnJ9Q z*Hs>seD*}i?id|XW|e${sWQ|@a4=Cas^qgHfiRbEY8HzBRD_$PNkmmItX^<%RlT4c zs~4QgN(@z~E|5wLyRs5Pd&bo4K-!w*@Za25wRBj6xm4pD&cX!)IhHCZtxX)YPaZ z;8+bUQf&HKL#C(^J)=rK69{|lnXpG(jw<=&P|3%~D*4h_*&hSbdM^Uku|}`~;JT;7 zj^fPLBhl5ANwZoB6)xJQB4_{gH6O#SmWrx}i52H%uu48woJUKzs5s9Q!XD8xD*L<5 zD*5D4$=9C6MD(cMkK9syA`={Itt7-lKoczR!fmu` z4ZeO655tq+UBo4gxOlea>r0P}Vv!~sgf(3x3las(!kR9U1UsOXPY zdbtFHI(qLRa}@~p$2yIO^JjAkmw*~_l86*hCa?o+KvE^9&${Ae!NdCapr!XN@dVeoXx)Gs0;SajYN8vvj-chl{f?Y+kS+DhRBk1z-*$VPkA)aqz+-TIBohVP*oA1{&|zp*q2^G1gQW zSpKx+Di!c8{N@dB8zM_TMt$SyhligdlTW~BITaBa-_y~keux?PK`M-=$)IYy1P>v< zC_nVmDmg|R>Vcw11XkNe+j>wwC=>Z0BbE=^kNy8>50GAL4-iTo-C@ZiMi~f9l!3ss zW`I!!0u#R=FiS5IzaTKnChlYD#d?A3!Fv7=l;t&q&_JJPcz%fG_b4Ak`8`u410`58 zkZSvKu>W5k%Lmc69vMgm&aVy3mIM&LATV1JK>UK11Q5R<&uskw@e5i%K>UI{*9L9~ z#rfY`mWLZ!Rr+#5}Y01Jjx3Dlo44=?I?fX9T@fu2H5D@WqM?aZ3oq z-0;Rk#7y~N*Id4VD6?yO_)4o_rQM(t69*5!Y1Elj;B}s=Mq47X{14ZmJ}dwbh=~#i zKo=!|oz)Nkk*x?a7({iW5Zy&)P|WL`#?yX%ynCZ7>s-Z+bxyfx>O6u)_3s;O;)D@5 zrDxXJ9#TQv;AH~_vpGJDIkv+P8D*Q;Sm+t%)e&C3m{&G&;s{_i3qTbCfQb!gGUyLW z{dk}7`Pw5scV-4rdy(VWV2T`%B%@fjk>k0}Hu)1kLZ~nU38BT@2h)wpwCQ*Bt6NHkiwxP?g2DAB5n$dxa|UQBh8M88!2nwfTuBV6azDXPZR~~2=eU8Jd+g6wwNH#v@;;vVxk%tSG^2^Z(Q!@ z7uMj_kz-+uKWAd~ME#r?X%!Y948G|lQF^gp^;zGnfNbxfYSybOss8V$hxzmkukpRq z_d|j1UoFu3-E5}(QH>zF^kiL9wPC;=??ut}seQuMq37}!|Gt6EYOz(l33jR1hK9}Z zXN@&o7Ia`Ft2ap1Z*j;dS8q@(hu`6l(IXcyCx@y-mg9@2-TT6gW{R@3pft%ocpGWK z6Vq5)P>YSd#EdJIAkBM<~HOiY%eE&Xz^r5_1??bzlUw7I%Dw)7(nkM{qI z!~TCsZ2v#f@VE`;U25yUOl&4D1qYl3Pn-p8uFW%(BYMO=aV9Q4O$5>8rmB54nD9rX zezd)Z8H7JgCeOWK+k1?|DgY|=qrE`hu}wIbmPe(21SXA$mHN?=fu;jv)Wb1qTZ>pfBGY|b3Zr4#&r8!4^mq|H4nq*QBzR_`->5RWkMnPVAm~S_f|VL)l2<#<$l4J` z*33ZGW-ziA1!gy%F*`BF?6OeBM_}6cfx!6^8wgC=U>+ZB@kd}wfIr096F5bykig>_ z2$sYUak4*Ph#?qa4W^Me|LuXYCDcu%x_M?gjUI=fN1XqC2!dxOod0R)@d$z#j3DY^ zinAw;j>uXDw)k7jw)oo%vPMc8ku^!S#ouj^wd;(m)eL6pA8q_VU@FLATl^9DIrGfa zKiVaNJX0|bd9DqNlO2ok_+dN}7*E|z5@@&=4TY)UWn2-m^1Af-wpQ_5f$*fFIoK^N|9%f~Fdss2x9HhEt zPR0{F&kk?1-jL#&`8ynnuyBx$n)y2%da`gx2U;R~Zni;Gn_wkJ();L4KGrIv5IsrS zTW2dyve0EgO)tMJ+vF3fB>&OrYw9N0JP;LvOl_n{s6vps_);NAAM9Viym&^l@G1VD z*mZ|#2ZoLN*-YHexM-4ta!1^b>i5#2+_hyAVA`)b{Jv_Dr!?z(VyB6-(Bw3$ZY=Hx ztf#3=zF8FqgOx6lE?2sm1i52jfB)dHPuSBTkm(kjX8PTJrr(W;wlAhH_%AO=%=vJZB5!Eo?}L1&TC?Hyr*1WdbB`XO+dLY#`^lIfdSQxCw+rrn|WBGj*qAsmFCfg ze)RKP<4~GMypDd$E1&(A7c0#pUPr&>^$oa=MSty?=emM1sr99Ayr*1WdTbEo!Wf&N zVckhlEP7;YigshCU)*BVc0|>v+HM_`x>zRb(T0AssmD0TdPLQzG_Q_e+61CbMSnF^ z2;v#N@m%c!hR9RO^|i;JQ!b2=E2y7SCZ^D>V+C|nr9=BsFolj78Exu8A`PQxq|ha^ zO+6X~u4{!L_XrtJsa7>|hue6K>*&g!qYc%ml&>G@ch5S!A&wSdG?O+|=V}vHDmXK;suxy0_?YFq z`XT-GD-PX}=z7c&UBAU43I-p0p_b5{cZWnLzE5cpr=#jUs^MYlv`D|Bby`%t$CN>7 zR_aGT+ef8-Oc|s_T|5Be#{NAQ;%VNC+f=JICimZrQ&X?qf-t9Kg6ch@c=RAo%eNwv z2gpIXb6^HqvqcD6#FdFvUA!@a<^F)=)r}@`1@#ygAxkth73IPh>*lM;Q(JN<$m_$Z z_cB@a9uxiOx4Wo%&lC#bXr>U}VbyyK{GU=k+69onb*u~gIrs~wx`KJGHJ8>9w$!+k z*q0t_%RPO=sc>eSil6jJ+8e<4r}$&yXOL^J_`!kMkFuX?7VVi781UX5=k z0bg}YZLu0VQ`Fc=FzJr=?4uexChHMhqw2j3R_f=5Qa@VIMWufA0ym&85WzPkKdWQ1 zi#|b3&%7FynaagXG&svuQ%dWkL}_`ZkqJ}iUeF6F>f6N>x_&hZdS7L}c>3lCx+WQ} zrouo44&}J2D)_`%1>e_d!aLsXRd4Vh5B5uF7t(C4f|a_VnsD^t-{uf>YP1il&!c_O z={L00NyS+zyMk74(Jys%BWdqhhhwz!UbxYH+C77QsY{d;ARafF$_fY7k@UJh7_9Xd zAD&?`poH)~4-dbsB>Y-ji0`E3xI^%wxbQzennmg^+sBXU_GlkJ`t2^J2GSZY`t2_I zc|Q7uEhZh(HX8IpUt9s>iRVk2tve=yXGyQ`nHU%L#;6mW`#$01fEj2i6RX?%`Ok8F zQ{+dhyXZH($<4OueOT727qz3Yhs8s<<#m%k+^~yjks#cJ2g2e!^QWt$9fPV ze7{~ns6V1jtQ2o8O7X6+QaoC|MWuLSQHn>Lj_USk`IZ@$Z&BSI(KM>t`vy$QxBjQd zZ!81T@~yg51l9^hr1edj;c@E&8uFfjHHdB@)Fx=y5RUW;>Rc~YT}Lajs1(lvQXVlc zlJbbAQIX$R6!}eIrFeA&i!yKnDgvv@2k``6-=aj!;P(WtDT!2leKkHiRUhhx`TEl1 z1=@H`i?v1I#&&Hg?8cFA{P_VVD{9whTKbB)x_$)^jIy~ z#1`Pvt{7CeN4sK}%gV6@xU_`^75UL8K1h(Z(2%vXr7bk5$d4P~|CA4ME4%fBYQ|hX zLnOTJPr+mRZ*hof!uxkvIKTLi)#u5OmUCI~iXE%ZQzwCsrit{PC9*4Ml@^usxsnL@ ztiuc1K!d`jgLB)J?hq01Blm>o-`u>ft zHG`FuBt(On77^pKRyVH3Wqwtg`x?mh^M2-5%S2&z;rn znWMJM%}MPNgU5^GD1Nnj%CnDn9# z)mP@!1Pyt$cWd(_gW^H{sv5cb(j!~PMT)B#)@6}GN9(epu!w6s zTf{{xYl($rVG-AH+OrS}9TstM53DQuineX1!a)J#yewGG>lYug5<&swyexi)Lpu-~ zXA~A%{E9<4wZ+dmTq9a{%jmucNq*~WM^K3l1>@zHwIlh28p(pWe2d;lY*;G$ik4LI zQ>>&0QWIKgMNMdN*AJR-XnX%<2|mr*o*FuQ%*u(Y*Pc9VGoUOqbxNC&DVqIG>pbi5 zxvKeD)?9)0_@S!D8LY?6RXx()9n_-->+wHLXh#jEQGWj;TGe)v$BsZeGx2nj`0szG zxNaK`HVDN^y@=vb^_B^AqV7y5B8ry{ikHIpAZ^sfM5Q52RH6bv0y9y`fq^N3L|`T= zsj?!n#({tOi&ip7; z?z6hEKGngL6CyBG`>qH`D*NtpwRGFpOk+4b}NksTW(eNp*fC?ogc{m3lF8r#(}G>IkL;5-CBH zKzfM;5-CBHKqAky|DPGMP2`!fP2`#Vw!?qHIN6QgmGCIenJ9cUs`KH86qf2EYgWv6;7v+hU#?y=NckLYLouo_3rLs9OLuXgsD>aWM zi-P;am#J<#XEjS*%_lzVF^rR4KK5mFn0(mun}x=4-WtB;u0?OV4~JPV2Ih2TzQ)Xw z3>}l|w(QoWE#x<0=+er21#5Q+XQ%enu^h6Dy_m>e%-53}+IMbmqjtOI>^yyIsbl&- zCS)2$raYL!Ve*A(I8gj#%7p0}Op-vs)H0k*w_uV2sy&$o!4wVCD4<}P6u#0i{h`SM zJ-IP%gz9j1&dy~py?{xUOnETb!ju7%JWw6UbQ-2NFpUEWrf`@FVVVF`Co*Ni^cf~a zpkQhlL8ca_WKz;5RA*<3D?-mPy`8C+p4=od<-s%wrmiqe2C560mci5qroVuK$rdJI zn5F{Nl}x8$5{F3*D44=wl7>kgsBX@h**gt&cb}1#UDIvSV8@`PuDyi4Vml;8be^hb z^h|W8inw{WjFj?h7eRl!f%ef!m(|-J=6#dpjyGkbBIfp{7}xwRhl5!-x(MfYI6T9` zS%q+Tb|~%`WbUfsDQ#)g%}X;o&QRDfIw?r~%xsr&0d~{G&2wZ9Pu0sy5|#Ffbx%|l z1^Dh6fL$2)2*Asm7(8cZqO!hYy3AoMy+HNlxWZjvGJ4qaS zYd!_RGZWoiWM(a(9vu*bCxU34NmZ|ZlBlXztZkz5P{$1>u0uSfJCS3}?3;$C9HPfl zN3&hp1lY|MFG`b{#lYeWECTSkGXOg>usy(<46Mq)Q{lM*V7i^j%)-gm#1I`Z#F|Vv z|Br#X3X~xl^2)RyJuagjAK?6tMi4wR;rw4gj~5ZdY6MXa(`*;90K2*3MOiWrRP~N0 zi7xPpJ(8$A%yEO6>k3cl8RS(nJIe5sWAykS^((c2U!4Kioq>-4Y{9_OndhnSJeGMD zgXdboIN25$k2}U=fbrDb^Z^Y+(9jqSasGK_idaHDO5yysM-a9Y1kX(S(BokxgNAhTTr0_6G5}o1|yEidnh~oxR*Iu5|lH{`fV0(C; z#yn4Do~OdIDDylRo{ye^=OfH>6&S%ELGa5FJWlqsMwxDkhZ_pxM6^2JKEMvArOO5B zB++fSEG|czxVD9NE`Va;*AD|(gMr}UM^h!Q1&63LkIz*NP5 z&?6ogOmY5sW8zDU=%uB1S$*H(Ilt;qGkdS0?!Gh9I%~Qu8|+xB>)LCXSF8ZVrKT79 zO!Urt@uJ%@Qg>#%Nc!7JIYn>sQQzlN)x?uEk>E)aM)mH1*DPa)qU?|{uHWJCZx#+? zTs%A^9)r)u8GKy4=;Bqzz40(E-mh%u2L!0WCQ-*yQ_wa=M%y9{g^xs+Q(v=PguwBN zGQshzlSIwDVh<)Nk6>U=fP*x%3G57T76WTDuv!y3{gl0F z0#z#k!d3Efl)Ro1$JF(lo3xF&wYx?(iFxMH<@ZY0PIn<0FK%cN$#wF2m89#PjU@pv z$Dx#jzW)J#qO0NsK_U~L03Ld29W^ajdzIWA@ILQOE;lWDM=dhnuA@vDPbJsB zG)c5c62&{!{eB4oW2`5A`vsH>-?O6;YJ(_O6E(!ywt%mC@FX$EAXBg}Sw_|F7@i`L zhP;sc7hpGC+&oj}0m*`ls_joyt|NG(S1f@gnP*RU4$;ge&(84tfq7ocJgdR;f5G^) zH=e7t$3*aya((Ub=adT%AzVRC!?0_mPE4UA_T`=!LGrIT*cT~u#J=JTbxH3H0#ze9 zZz|+GsYZd@GDic@No|K*qGP{+a(y9r5;zNADc28J823!os1w9DT@q`ET`}>E*jJj2 z4^!%hec2{Ph(oEH&t$#xTmU~~8lWrlOfnF!Ss2eL*H@Ca3mo=^sf*WClJBmIte9Vvqo0iMN_!FCKxcN}xq zAxuWx0r06q0C#UF7+;OuF~pxTItQSBN|U&QswwAGH_Fv0)ME_0o}6eFE}W`{5c^J% z#zU`}GPnSe+$=RHgR7tnDi4P;c+L~b;MH2deHeHUz$=)HxSxR!!}Dn7c?vu~V47pC zV2r21*|Gm^jH{mcD+^4{4+vd7Qd*LZrIcYKA&)V!7%;I-L11E%0d|YUi(bk+AQ6x; zF=x=W`ht6rsz_8zGdspmmo(%c_4drO5U@Yri3mPCV@?H`+3%>{B z!nIwEgmKNZ2E%sM$gZSQeUHg-hD?Stf`V7Dmfj&5E)ingrsQlU!^toiF5o*sFNi~D zt?ruN7j163OBu;`@c1A3j(TO{U-GX^d|`5ULAkysc|6T&5w9bqP6K)x@jBAeMnHUv z5P|p>$Yeb#_`746LCOwgyBJuFftjqw6)B5|wvfkbWjQ5%qjsgwMD4x9bcV zw*9WSt)Z|op5_PoMlW$~3x>vhs4fct#B2LA1Q5Xj@J9e3V#>QOB37iHx^NvDfdB@x z0DKUD9Rg5clLZ3Qr7L1RG#{}x2CA8TfVv?ej-09J<pds_UZ` zXR2DLvKHKZV*!Tv7_)H(pVzM`uK$~S3uCMscl#;*=?-5%M={xtNE;RCsi5YLNE=o2 z5ox1pJ|@l)X`^bsLlEb>R|l)sr}VF`;JT-{956)2@c#GmE&B3rcN(foa-C@Xn zqnYeSJdCROR8VtAJdCRO2C-^BR-i|ujjH*64z5q>-+$`_aT=R|sNt){0=|Agh`4O3 z2j6OZ^6CS|_@zfFC?f4)swtl}fEDPmGCJa6RLw^U3^idjcf`Y}nvcXh#>1$ZuW{hI z)(PT~mn*Dn8YbfR;#*wGV11=`)k+ANvPRS@TSkg$cKWQ0P69F<@i5Zth=)-%9|^oc z;9;cMH8J=XK|j^@B`VTLfjzhiP`} zST!FN;+VKTW13wsPr#T6-gB$3J>nU{4MFghZlOn7RmJsumI%Z$B5$whF81`-^K$K;&XU+#>o`KV)gG zz93q$zr!K8RfHS3RP66?=*7YT?}_EYp{kxWoqSF4B3j0GmP9zZUL2##(HASwqhl&2 zWa1oQsG5)PY{eE;^VPBRkCu1U7hI2|SCePB@R8*$<3f)==Vjlc8p4UbF72A`5=ly& z>W`GTpH=g1D33HeW$~rpFZ7ZblMWrLD)^XmxacL54#k;tI1kcc$+c*vHqNQ)_?vfr zP$dWg)L{C?(^XsFC)Gyd3^h0})wqWBShdAuzXh!3ZWv@gVqa8qN2|1`=8o29(poSk z`^{xFcl8I4WuEI;`d0;Rq7>IxMu&UC_nhbfuS_*juBOah)#MBJgnhUOt0kdWUEM5J zphpTFTct(Sd_z!Z*NZLArBzx~&F6q>zI{yvK3ZFyAlFh{Usr(fcCip5E; zM)F`{2`yn(pvROtTBSwRd?eP;sxGF~(JC#f=3}xRE$O0aK5m1n>ICrs%zGAwhX|gn z+WMa4<>GAcYSk9;I#TM0*HM8U72;5V9#iUQl@?X=kxUzeC0(>gmzH!&L_*Z7QF!f(a-Z$AL?z6COix$^(Q$rTZM;SRAE+4XLI}ut7ds$tAXdV^l*|7pW zHCivb)O9{>*g*w)U1=TdGf^j2)8`XW)r8gbNmSMJ+0lYsij-s_YNA`!gp~m{RTI#d zt{{05jO6|J&>pl)g3+$u;t;e;g3&H}-W}2dFm9LC7IM{t6yd60jt|0*Y7bd~-Vum> z%bD0mtF)+^Zz`(!h^kRFpD3&5V+DG&69-lEeFLsn>0e#Jh_r5$>kDdD-OK*E!+m}E zRc-EBg6S)nf_t8saAq~pV?7pfkvPOQ*PsGD+FXOG`A86An`_WIU)o%Qs`;j(nopb+ z=+zOtsy?NE{{@5NHJ+-C#zZuZI5j9?hUn|TxbR$l1)(-UN(;U$;Oi^f!6i}6M2a3; zghd5l+wW(T4 ziz#%pUj~)WvGumJV(TDQY*A$&F)>B9VvDM_>>=k(;{sS%1-jrirWsZp;zPpC%`$!; z#`S}o6PHaH4jU@zY_4U}+j%CvEv%}ad&8u+xm8trW0~~!gh_7~s|x+TG%2MLK)h4S zV%={F_r6)#dz=>k&PQi8E&j#*Xbmp+?>Q0AOuwdt&<6@rUkv+e(g_a{O>bfadWWFY z5wD|azDcY=PX*O{v`UMr`G!K)lVh?TE$O0aK2mll`&GU4uj#-T^;gP;uP8T|c#-(} zmU4aRk!aTx(5}^tf&C7LcUU+m74+f4p#)0t=F<)x{SqVksG$h&>3nhXNa~B#<&ANQ zPV!N|Ks4`wq3(WC{AgyXnsj4Lj8}XjPNLtO+ao(^V%akD9Pb!1)bt0%muC zF}q`RJ7l!$7--i89v=Q@?+jeeHIgZO%QY1-tHD=oTUlh`bM}Q49sWTwObs=Bv`UL= z_(&Ww!78mz)C9^Pt;A((@rc|GDH5L)$ZLP@sC%`cx7~c3ICjc)S=GGb{Xwf9Twa9L3q&68$y9+ zIO#X%?ljC;GAvxi^s?hpSGgC_m(}|k>OB)Z;4i(V+g}TN``ewq*gi4h0bnZtyTV1- zbaX0)PLH6|D0I3Uo%*8F=M zF0SHU7&ae*z}FZTO-gh1srct^^cw0;%cVo2@*&6Pm(^SSvO^3RU)o(T0jKDqSH{P1 zH$DgWrWVHMQ5hh7Wp}}O;Q~kn-Qhc07@x$!=nh}jhY^!KV#24C3m{#LwHF381$|<` zO=X%jS3gEZDmr@2bI~bUF2kt=V3?ntYcD-L|25rCUx;<05&*~NzUtF_r5F0!O=aLH zfJGU2Fu+Hb1AK&m?VA9MA!3qsF`Gv*x1!&elw8~HxY+)M@{l!p_eCcz9cC-jrQO2b zSL|j!i$0;g{nlJQL*efJ(kr^1yzIye=t=~j$^v+S03IR$2Nu8;1mMYHHAJjjhdxID z(Fj131>lPS91*}dHd%UzRh-3IH>j3NKWe*NZyil1o!OJ>+g0c4?;;=dcw+%;v8t+t z9&_cyTs6rX{uts_HbgeZh8W^1HpE2C#tXWRPT{fk96mkthQA#%;mL3XF0DQ=-2sYM zrcbzuSfSexe0Sr^MAw+^B0l&=d4{L1T*S&Pm@PW3#)0qz)fcnT5wW#FY}H^Uj#``P z!O+BUgJRBk^LqcSrE%o>ao3`+dt^T8w@5D~zTnM)OVar{>(~A@&!yP>`nA*NW6R_h zCqI~@|B-%Q;=!EkioV`?uf&V256rW)pfLVzUGyY~d=x#wZMiRI?*InU2r|bT`c)(6 z!w}*ygs=3gjx4PyV0EBUzS5(JZC!}nXP6;8Y}7K>z`N10M8vpbj)w0`%=dZLr8w*I zKW1*SG#=5fnmC^&K9j-t=qA(sBBMr@#wA!aDn%#zxoCf1X>(#)7h>HEGX@SDW#GD= zr{tZv~e&F^nFeXjmZnFmq402^Q;@U{5?6M^qkWqh6T z%*4JaK~1FaHQF9Q@XEx<&^C-1+^{XW#y7h#0%?U?!57BVP|)3IiRYr*F2vd!3Rgco z#jJEaJQwBJVGS&gOSJ2!EblaK$RM0j2y7qbpJygK>P$nA>>&a)RH|_%U+H0t;n61U zQPCHObTOTc7@jT|-dx7;_E5C|lsKY;!>-uPzZ-qwzNqfNVSW=`ckj3m+s;t9Czsw} zJdYpG_4C2=A{fu>36|pnp0}G(LJ6=OT?SQSP%yFx#>ku)6pU;)V`LIw3%ZPvaUIGS z*<2O?7};*d$S$y086z9UVg)0M;5rn1X*c6b7uXCizO5Qb5SCJq#{x?eb;kLMWnW*B9gxEr#_mgh*Ow~NSD=f z(LM}3h)IsiAvx~!f`?&Xw#^+)`?u&Id@rZua#QAEcU%0)?{hXyW99A!?bRm`= zK}jc~m`FGxvgIpHzw}3HQB#@erbE6-XQIp(^G)Is`L5NBo1Ysv>~x%bF?{>gNU!P$ z`|Vj6Mp_55)*x7oc`v2}5)X4S%n*nC7s$jzqGu!!a?|X}x)fzyG6~X%by;Pui8nQE zuI%?>VYnZR$ED1zyjQg>8q0e{N9R(`%U7BE}DX(FN9ITOPe&h(l_{9@MdF`M3=%uxl5KzjeA=q;??lh z(^O(-5sf2X|TcLHtVz~36f+Na`>FMjQ2{%}r2(cPl$=34Ky3$+Whi;~`7=X@-GAaY4jJL7ZA2&uAyc%6)d3Fi}B z)M7U$&v1UWQ^9iQYK2KZchTEO!7V*ICT=9T@JJ^YvM!_Gg0u5kmW^!E``(2~g-HcT zMdRQ1U4LM_*zv!Pi@C*Y%dyYdlXEO*XHJE8&cQg7vh?-=I_q{mKWJ0gJ}gfwCW_nU*sFYvd+snh=htCk&Tj?iothq}aqvEg7TA{C_GP*RL zb7zOO$irAO)gu+Rgd{)sq#D@t933O4u5Ucb%K3R&titk7hn_FfpW(7OHn&^8-r?sl zv5WOSjrEgt+02QmELdCFUe-_2!L>ZcCUb1qLnD3p>rvL}k~XtTgHjboSs!_x7@MN^ zNx`p^%Y@~hjy~7W7aCO-VWqYFleFJFmyozzb^TNuUz<%Q6>Z~k`6r8UXo~K8k9ODU zxYn0uJ5?!l2Pbx`{(LdNx=qiYHtUW*7nnE$({n;+>I6Txk2F1JJ$!Y_Hh&sB>P21S zaaSyg&*iUR@x*y|KcRJC3&j(oc>Hj1T>BP!pJeC+X9;^glT~kBn6)SlrVk zBsO=BzV|4rBhQOHa)oqq;>AaoP3#$MQz?6?XxP#fPDf7W3Rr(=S-L4{l#D|ir{;v> zvIn{RSBKEl$ldq;a7wG=J{F3`haiqZ^zK=8JW(E#I9i9Yb%v*$5!_DYEJF@Qc^WuFuC!zv!xl;;H4 zR202Sw5j}<&nZdBugv%06jp|nxhh`g#AJHdaNed`e}0=ERu*r=dGe+>tV}0$GpE9m zlYcg>EYTyZBGslcr;|-UNkx8TVX|c^=Yy=xCQcttMY19%KFr2lvBGAiTFX}5n>B0J zmi`TFX4`9(h)VNj%|u%?Yu1S@>(@wH8k?=wH8x&7V!h#-{j*}GhmY)hy{O02l$HHg z4O%e9D?&|k;uhtV@uDfC=k^=t+wWoJgtwYQO){^H%1nL`w=rm}%%06B*FJpJ*M4gI z_G?#ee_YmALFQnB>80| zn5RlU7tY*zC*L{Kua9{`bnBV<#od)y=ow*+MVU{qe02@@F)z<*r;F)qcKWntS(9(Sdt& z1m6AeGW3&tte-^3><5y?>DJ5iHnuJ9Z!(e7{mrpYVrvBKw=CMb+@x2e>LpdxZqfIT zPB)0^JO9bhwST=hZ!NQFWZOy0>@x(vpLE4%`2&4gH*2OL*sNK%s!6w4p=YQk$^J@V z;@@ehAAB^WS7_0&DWSHR5gniR(7F;OdjHm~RkAZp-JW%`y8CR|y=m*BE^b@qsXAxn z6E)A2jptqnZ+*;PF(z^LRm}{^4hxn;j?e<_n#A^ z=oGT{_VI2~SGUbQ{WizL{?g#KcRspJ-ySZ1@{y(Ni2T^n1pdmHz{TDP@8r#`<(ri$ z%zq=XG}$`lb?o|8Co;@jECaHiB#AH1Or3wr*kWuy z+!tFl=hE#G1%b`YvTokqBdVgVA$?0B?V4Qwc6&xOUw>rDyXihJV>~ZT>uDc)!fVw+ zp|icjb(?SaSROeq-s2Sg>#MkFUHNK()N`*TKu(TbTcdQf0`MqON~k&d*;pc;1+$h{ITB9EbP=HFct&iPQtrvR*>RmRru)?k_ua;1Mr7Jz3!%V~Tqz3+@^` zu$^9U${+V6EIJ zpVWc7<_zxMN?+7z`<$fp9cFYtu)j~{(bsof=T8Gbz4Z#ix8-4-gn{tDTmvhq~W z@V|SkHD2;c`Of8h-<8^v+f9xX%~FpII*^o}X|z4_@wrjz!u`q)_novy_e!MWtUnfC zJhY~R>5ZsplT=S-_lpo6(x>8tPTnHuG*U?&avp6-aSGtX!}g33zO_-k4PW9pc4$Havljrce3 z?=xoP)WN+4Lc%IVrz9_0A^&QUPHe2~sMK;3`|_0!Z^S*^pr?NGQE*FxhmZYd{XMM2 z`%yt=ON0J9R<@cyh+jc1-XpqGP-O2cHAxX^-I1Yb6Efb*Pu-NPHoV-u-S-FQ~X8{j~K+yWSZAs+E6TdilQlnPx_=A}3F7=lDfiO`-ODIGV3`x)rtfj7g_CXJ+^1tcoDPT`ntDRI&2!<_a!)>{ zD~}s|bN7ldf9&t-KBh&Bmpy&jDKAvp;(WP7SfXH_m!AIPzxJmd+xBR|jy&1J?H1ft z>E?LD=3dVr?-hPFr}Q*}i#Wr_ZdN>Iw{%PCie)yl%3Az0YJt)4z3O@)Yu`9(hxdQn z>TY0LjbQ&k%YY9XM+NlLTl%tH<*1|qf&ZND)8mA+&C%YbGLQ7M_x6}PS>U56zv*b- z9)r?W%JwW5<{aAJ=VNBx#|v>i=XvifpCF;OF-+5BLx*VD@6WbL2gO_wI@>epA*u_V z?d8VHW||qBm`g4*Hq*lycelT{iXNl3=WlLzI(YbVuSs3}TN*}rZJnsGU}Lw3ce-4) zKJ<9(hBEQ#8H3X_4xV?ZShsH0)n{HKN?Yf6J{S`{YFpR)No~Cn`-FHqziz3zX~}}i zaVyR}=s$kJXv-b}4uWmGYRTwyk^d%HwC3hl;iyuC~D5JN&L| zCI3wKo#n3U`TCltT5rql^!=PJzIOJJCCzE)mh|u2IbCXEQZ=PFr@tN9d2;cl$ypQD z&K~$dQ+~?1E%VQRZtmOZx}DxGM8@z^Q^u z%Wq2<^p<-!EYn}a>P3<}XIXE1Ge_SPrKnF^a#fGp&H2z=xc3bS5jhF1N!@$8oi;i# zM^0^-v*^`>7f)&48D6~BaCFl8ij-}G6yl5i-@N&(nZg}Q<&HU&dBl`_xqji)>v{b1 z&3{k$v}6b0L8-MGf0z8pFZuE!`&3@J)S3sE7kW5mUwD7k+u`$B#B% zhJ_E3izfuX51Gv!$^QHEq$C;*XNNYz#JVKHl|QyY7Rm|F3C# zzvKq!=}zc>b#RAy4VQHNVvfGoHo0A;ikyhPac znpYAZQdy8%91Ds!bOS!k_q_EIsN5T9EH_je#DIJt6?ECBGENIb&+0t6{tZ6 zs8I?TS}eg+8?bNYZu5859p2JZGMDb@#5;PyGX zYtZ{qAcG*@a1UXGnF8xop=(C(4MDW@Q7Z-~>WDU@WyJfWim>EKzip literal 0 HcmV?d00001 diff --git a/tests/testthat/test-ids_bulk.R b/tests/testthat/test-ids_bulk.R index 6999c3d..e7c73ae 100644 --- a/tests/testthat/test-ids_bulk.R +++ b/tests/testthat/test-ids_bulk.R @@ -1,5 +1,3 @@ -devtools::load_all() - # Set timeout for testing options(timeout = 60) @@ -215,23 +213,18 @@ test_that("download_bulk_file downloads files correctly", { unlink(test_path) }) -# Live, unmocked test -test_that("ids_bulk downloads and processes data correctly", { - skip_if_offline() +test_that("read_bulk_file reads files correctly", { + # Loading the sample file is slow, so skip on CRAN skip_on_cran() - # Get a real file URL to test with - test_url <- ids_bulk_files()$file_url[1] - - local_mocked_bindings( - check_interactive = function() FALSE - ) + test_path <- test_path("data/sample.xlsx") + result <- read_bulk_file(test_path) + expect_s3_class(result, "tbl_df") +}) - # Add timeout to download - withr::with_options( - list(timeout = 300), - result <- ids_bulk(test_url, quiet = TRUE, warn_size = FALSE) - ) +test_that("process_bulk_data processes data correctly", { + test_path <- test_path("data/sample.rds") + result <- process_bulk_data(readRDS(test_path)) # Check structure expect_s3_class(result, "tbl_df") @@ -255,4 +248,25 @@ test_that("ids_bulk downloads and processes data correctly", { expect_false(any(is.na(result$series_id))) expect_false(any(is.na(result$counterpart_id))) expect_false(any(is.na(result$year))) -}) \ No newline at end of file +}) + +test_that("ids_bulk downloads and processes data correctly", { + skip_if_offline() + skip_on_cran() + + # Get a real file URL to test with + test_url <- ids_bulk_files()$file_url[1] + + # Mock slow-running functions + local_mocked_bindings( + check_interactive = function() FALSE, + download_bulk_file = function(...) TRUE, + read_bulk_file = function(...) readRDS(test_path("data/sample.rds")) + ) + + # Check that output is a tibble (add more assertions here) + result <- ids_bulk( + test_url, file_path = test_path, quiet = TRUE, warn_size = FALSE + ) + expect_s3_class(result, "tbl_df") +}) diff --git a/tests/testthat/test-ids_get.R b/tests/testthat/test-ids_get.R index 9830273..8e2fe34 100644 --- a/tests/testthat/test-ids_get.R +++ b/tests/testthat/test-ids_get.R @@ -1,5 +1,3 @@ -devtools::load_all() - test_that("geographies input validation works", { expect_error( ids_get(geographies = NA, series = "DT.DOD.DPPG.CD", counterparts = "all") diff --git a/tests/testthat/test-perform_request.R b/tests/testthat/test-perform_request.R index e1c3946..596805e 100644 --- a/tests/testthat/test-perform_request.R +++ b/tests/testthat/test-perform_request.R @@ -1,5 +1,3 @@ -devtools::load_all() - test_that("perform_request returns data for a series resource", { resource <- "series" result <- perform_request(resource) From 92c0a54de04389d44839815c23983515cf147204 Mon Sep 17 00:00:00 2001 From: Christoph Scheuch <19249734+christophscheuch@users.noreply.github.com> Date: Wed, 6 Nov 2024 08:20:18 +0100 Subject: [PATCH 09/10] Add missing test_path to tests/testthat/test-ids_bulk --- man/ids_bulk.Rd | 9 + tests/testthat/test-ids_bulk.R | 545 +++++++++++++++++---------------- 2 files changed, 282 insertions(+), 272 deletions(-) diff --git a/man/ids_bulk.Rd b/man/ids_bulk.Rd index 96c10d8..c5d53cf 100644 --- a/man/ids_bulk.Rd +++ b/man/ids_bulk.Rd @@ -46,3 +46,12 @@ geography, series, counterpart, and year.} This function downloads a data file from the World Bank International Debt Statistics (IDS), reads and processes the data into a tidy format. } +\examples{ +\dontrun{ +available_files <- ids_bulk_files() +data <- ids_bulk( + available_files$file_url[1] +) +} + +} diff --git a/tests/testthat/test-ids_bulk.R b/tests/testthat/test-ids_bulk.R index e7c73ae..d789e43 100644 --- a/tests/testthat/test-ids_bulk.R +++ b/tests/testthat/test-ids_bulk.R @@ -1,272 +1,273 @@ -# Set timeout for testing -options(timeout = 60) - -test_that("ids_bulk handles custom file paths", { - skip_if_offline() - - test_url <- ids_bulk_files()$file_url[1] - temp_path <- tempfile(fileext = ".xlsx") - - local_mocked_bindings( - check_interactive = function() FALSE, - download_file = function(url, destfile, quiet) { - file.create(destfile) - }, - read_bulk_file = function(...) { - tibble::tibble() - }, - process_bulk_data = function(...) { - tibble::tibble() - } - ) - - # This acts like an expect statement to verify that the file exists at the - # destination path when we expect it to - local_mocked_bindings( - validate_file = function(...) file.exists(temp_path) - ) - - result <- ids_bulk( - test_url, file_path = temp_path, quiet = TRUE, warn_size = FALSE - ) - - # Check that file is cleaned up when we're done - expect_false(file.exists(temp_path)) -}) - -test_that("ids_bulk fails gracefully with invalid URL", { - expect_error( - ids_bulk("https://invalid-url.com/file.xlsx"), - "cannot open URL|download failed|Could not resolve host" - ) -}) - -test_that("ids_bulk requires readxl package", { - local_mocked_bindings( - check_installed = function(...) stop("Package not installed"), - .package = "rlang" - ) - expect_error( - ids_bulk("https://example.com/file.xlsx"), - "Package not installed" - ) -}) - -test_that("quiet parameter controls message output", { - test_url <- ids_bulk_files()$file_url[1] - - # Create a small mock dataset that read_excel would return - mock_data <- tibble::tibble( - "Country Code" = "ABC", - "Country Name" = "Test Country", - "Classification Name" = "Test Class", - "Series Code" = "TEST.1", - "Series Name" = "Test Series", - "2020" = 100 - ) - - # Set up mocked bindings - local_mocked_bindings( - download_file = function(...) TRUE - ) - local_mocked_bindings( - validate_file = function(...) TRUE - ) - local_mocked_bindings( - read_excel = function(...) mock_data, - .package = "readxl" - ) - local_mocked_bindings( - check_interactive = function() FALSE - ) - - # Should show messages - expect_message( - ids_bulk(test_url, quiet = FALSE, warn_size = FALSE), - "Downloading file" - ) - expect_message( - ids_bulk(test_url, quiet = FALSE, warn_size = FALSE), - "Reading in file" - ) - expect_message( - ids_bulk(test_url, quiet = FALSE, warn_size = FALSE), - "Processing file" - ) - - # Should not show messages - expect_no_message( - ids_bulk(test_url, quiet = TRUE, warn_size = FALSE) - ) -}) - -test_that("ids_bulk handles timeout parameter correctly", { - skip_if_offline() - skip_on_cran() - - # Mock a slow URL that will definitely timeout - mock_url <- "http://httpbin.org/delay/10" - - # Mock interactive to return FALSE - local_mocked_bindings( - check_interactive = function() FALSE - ) - - # Test with short timeout (1 second) - expect_warning( - expect_error( - ids_bulk(mock_url, timeout = 1, warn_size = FALSE), - "cannot open URL|Download timed out" - ), - "Timeout of 1 seconds was reached" - ) -}) - -test_that("ids_bulk handles warn_size parameter", { - skip_if_offline() - skip_on_cran() - - # Get a real file URL to test with - test_url <- ids_bulk_files()$file_url[1] - - # Mock download_file with mocked_bindings - local_mocked_bindings( - download_file = function(...) TRUE - ) - - # Mock validate_file with mocked_bindings - local_mocked_bindings( - validate_file = function(...) TRUE - ) - - # Mock interactive to return FALSE - local_mocked_bindings( - check_interactive = function() FALSE - ) - - # Should show warning with warn_size = TRUE - expect_warning( - download_bulk_file( - test_url, tempfile(), 60, warn_size = TRUE, quiet = TRUE - ), - "This file is 125.8 MB and may take several minutes to download", - fixed = FALSE - ) - - # Should not show warning with warn_size = FALSE - expect_no_warning( - download_bulk_file( - test_url, tempfile(), 60, warn_size = FALSE, quiet = TRUE - ) - ) -}) - -test_that("ids_bulk validates downloaded files", { - # Mock an empty file - temp_file <- tempfile() - file.create(temp_file) - - expect_error( - validate_file(temp_file), - "Download failed: Empty file" - ) - - # Mock a non-existent file - expect_error( - validate_file("nonexistent.xlsx"), - "Download failed: File not created" - ) -}) - -test_that("download_bulk_file downloads files correctly", { - skip_if_offline() - skip_on_cran() - - # Get a real file URL to test with - test_url <- ids_bulk_files()$file_url[1] - test_path <- tempfile(fileext = ".xlsx") - - # Mock interactive check to avoid prompts - local_mocked_bindings( - check_interactive = function() FALSE - ) - - # Test successful download - withr::with_options( - list(timeout = 300), - expect_no_error( - download_bulk_file( - test_url, - test_path, - timeout = 300, - warn_size = FALSE, - quiet = TRUE - ) - ) - ) - - # Verify file exists and has content - expect_true(file.exists(test_path)) - expect_gt(file.size(test_path), 0) - - # Clean up - unlink(test_path) -}) - -test_that("read_bulk_file reads files correctly", { - # Loading the sample file is slow, so skip on CRAN - skip_on_cran() - - test_path <- test_path("data/sample.xlsx") - result <- read_bulk_file(test_path) - expect_s3_class(result, "tbl_df") -}) - -test_that("process_bulk_data processes data correctly", { - test_path <- test_path("data/sample.rds") - result <- process_bulk_data(readRDS(test_path)) - - # Check structure - expect_s3_class(result, "tbl_df") - expect_named( - result, - c("geography_id", "series_id", "counterpart_id", "year", "value") - ) - - # Check data types - expect_type(result$geography_id, "character") - expect_type(result$series_id, "character") - expect_type(result$counterpart_id, "character") - expect_type(result$year, "integer") - expect_type(result$value, "double") - - # Check for non-empty result - expect_gt(nrow(result), 0) - - # Check that all values in required columns are non-NA - expect_false(any(is.na(result$geography_id))) - expect_false(any(is.na(result$series_id))) - expect_false(any(is.na(result$counterpart_id))) - expect_false(any(is.na(result$year))) -}) - -test_that("ids_bulk downloads and processes data correctly", { - skip_if_offline() - skip_on_cran() - - # Get a real file URL to test with - test_url <- ids_bulk_files()$file_url[1] - - # Mock slow-running functions - local_mocked_bindings( - check_interactive = function() FALSE, - download_bulk_file = function(...) TRUE, - read_bulk_file = function(...) readRDS(test_path("data/sample.rds")) - ) - - # Check that output is a tibble (add more assertions here) - result <- ids_bulk( - test_url, file_path = test_path, quiet = TRUE, warn_size = FALSE - ) - expect_s3_class(result, "tbl_df") -}) +# Set timeout for testing +options(timeout = 60) + +test_that("ids_bulk handles custom file paths", { + skip_if_offline() + + test_url <- ids_bulk_files()$file_url[1] + temp_path <- tempfile(fileext = ".xlsx") + + local_mocked_bindings( + check_interactive = function() FALSE, + download_file = function(url, destfile, quiet) { + file.create(destfile) + }, + read_bulk_file = function(...) { + tibble::tibble() + }, + process_bulk_data = function(...) { + tibble::tibble() + } + ) + + # This acts like an expect statement to verify that the file exists at the + # destination path when we expect it to + local_mocked_bindings( + validate_file = function(...) file.exists(temp_path) + ) + + result <- ids_bulk( + test_url, file_path = temp_path, quiet = TRUE, warn_size = FALSE + ) + + # Check that file is cleaned up when we're done + expect_false(file.exists(temp_path)) +}) + +test_that("ids_bulk fails gracefully with invalid URL", { + expect_error( + ids_bulk("https://invalid-url.com/file.xlsx"), + "cannot open URL|download failed|Could not resolve host" + ) +}) + +test_that("ids_bulk requires readxl package", { + local_mocked_bindings( + check_installed = function(...) stop("Package not installed"), + .package = "rlang" + ) + expect_error( + ids_bulk("https://example.com/file.xlsx"), + "Package not installed" + ) +}) + +test_that("quiet parameter controls message output", { + test_url <- ids_bulk_files()$file_url[1] + + # Create a small mock dataset that read_excel would return + mock_data <- tibble::tibble( + "Country Code" = "ABC", + "Country Name" = "Test Country", + "Classification Name" = "Test Class", + "Series Code" = "TEST.1", + "Series Name" = "Test Series", + "2020" = 100 + ) + + # Set up mocked bindings + local_mocked_bindings( + download_file = function(...) TRUE + ) + local_mocked_bindings( + validate_file = function(...) TRUE + ) + local_mocked_bindings( + read_excel = function(...) mock_data, + .package = "readxl" + ) + local_mocked_bindings( + check_interactive = function() FALSE + ) + + # Should show messages + expect_message( + ids_bulk(test_url, quiet = FALSE, warn_size = FALSE), + "Downloading file" + ) + expect_message( + ids_bulk(test_url, quiet = FALSE, warn_size = FALSE), + "Reading in file" + ) + expect_message( + ids_bulk(test_url, quiet = FALSE, warn_size = FALSE), + "Processing file" + ) + + # Should not show messages + expect_no_message( + ids_bulk(test_url, quiet = TRUE, warn_size = FALSE) + ) +}) + +test_that("ids_bulk handles timeout parameter correctly", { + skip_if_offline() + skip_on_cran() + + # Mock a slow URL that will definitely timeout + mock_url <- "http://httpbin.org/delay/10" + + # Mock interactive to return FALSE + local_mocked_bindings( + check_interactive = function() FALSE + ) + + # Test with short timeout (1 second) + expect_warning( + expect_error( + ids_bulk(mock_url, timeout = 1, warn_size = FALSE), + "cannot open URL|Download timed out" + ), + "Timeout of 1 seconds was reached" + ) +}) + +test_that("ids_bulk handles warn_size parameter", { + skip_if_offline() + skip_on_cran() + + # Get a real file URL to test with + test_url <- ids_bulk_files()$file_url[1] + + # Mock download_file with mocked_bindings + local_mocked_bindings( + download_file = function(...) TRUE + ) + + # Mock validate_file with mocked_bindings + local_mocked_bindings( + validate_file = function(...) TRUE + ) + + # Mock interactive to return FALSE + local_mocked_bindings( + check_interactive = function() FALSE + ) + + # Should show warning with warn_size = TRUE + expect_warning( + download_bulk_file( + test_url, tempfile(), 60, warn_size = TRUE, quiet = TRUE + ), + "This file is 125.8 MB and may take several minutes to download", + fixed = FALSE + ) + + # Should not show warning with warn_size = FALSE + expect_no_warning( + download_bulk_file( + test_url, tempfile(), 60, warn_size = FALSE, quiet = TRUE + ) + ) +}) + +test_that("ids_bulk validates downloaded files", { + # Mock an empty file + temp_file <- tempfile() + file.create(temp_file) + + expect_error( + validate_file(temp_file), + "Download failed: Empty file" + ) + + # Mock a non-existent file + expect_error( + validate_file("nonexistent.xlsx"), + "Download failed: File not created" + ) +}) + +test_that("download_bulk_file downloads files correctly", { + skip_if_offline() + skip_on_cran() + + # Get a real file URL to test with + test_url <- ids_bulk_files()$file_url[1] + test_path <- tempfile(fileext = ".xlsx") + + # Mock interactive check to avoid prompts + local_mocked_bindings( + check_interactive = function() FALSE + ) + + # Test successful download + withr::with_options( + list(timeout = 300), + expect_no_error( + download_bulk_file( + test_url, + test_path, + timeout = 300, + warn_size = FALSE, + quiet = TRUE + ) + ) + ) + + # Verify file exists and has content + expect_true(file.exists(test_path)) + expect_gt(file.size(test_path), 0) + + # Clean up + unlink(test_path) +}) + +test_that("read_bulk_file reads files correctly", { + # Loading the sample file is slow, so skip on CRAN + skip_on_cran() + + test_path <- test_path("data/sample.xlsx") + result <- read_bulk_file(test_path) + expect_s3_class(result, "tbl_df") +}) + +test_that("process_bulk_data processes data correctly", { + test_path <- test_path("data/sample.rds") + result <- process_bulk_data(readRDS(test_path)) + + # Check structure + expect_s3_class(result, "tbl_df") + expect_named( + result, + c("geography_id", "series_id", "counterpart_id", "year", "value") + ) + + # Check data types + expect_type(result$geography_id, "character") + expect_type(result$series_id, "character") + expect_type(result$counterpart_id, "character") + expect_type(result$year, "integer") + expect_type(result$value, "double") + + # Check for non-empty result + expect_gt(nrow(result), 0) + + # Check that all values in required columns are non-NA + expect_false(any(is.na(result$geography_id))) + expect_false(any(is.na(result$series_id))) + expect_false(any(is.na(result$counterpart_id))) + expect_false(any(is.na(result$year))) +}) + +test_that("ids_bulk downloads and processes data correctly", { + skip_if_offline() + skip_on_cran() + + # Get a real file URL to test with + test_url <- ids_bulk_files()$file_url[1] + test_path <- tempfile(fileext = ".xlsx") + + # Mock slow-running functions + local_mocked_bindings( + check_interactive = function() FALSE, + download_bulk_file = function(...) TRUE, + read_bulk_file = function(...) readRDS(test_path("data/sample.rds")) + ) + + # Check that output is a tibble (add more assertions here) + result <- ids_bulk( + test_url, file_path = test_path, quiet = TRUE, warn_size = FALSE + ) + expect_s3_class(result, "tbl_df") +}) From 57c931e2e2ca6d9bce771977d2b6510689efbbbe Mon Sep 17 00:00:00 2001 From: Christoph Scheuch <19249734+christophscheuch@users.noreply.github.com> Date: Wed, 6 Nov 2024 10:47:01 +0100 Subject: [PATCH 10/10] Add tests for column names and types to test-ids_bulk --- tests/testthat/test-ids_bulk.R | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/tests/testthat/test-ids_bulk.R b/tests/testthat/test-ids_bulk.R index d789e43..96cea4d 100644 --- a/tests/testthat/test-ids_bulk.R +++ b/tests/testthat/test-ids_bulk.R @@ -265,9 +265,20 @@ test_that("ids_bulk downloads and processes data correctly", { read_bulk_file = function(...) readRDS(test_path("data/sample.rds")) ) - # Check that output is a tibble (add more assertions here) + # Check that output is a tibble and has expected column names and types result <- ids_bulk( test_url, file_path = test_path, quiet = TRUE, warn_size = FALSE ) + expect_s3_class(result, "tbl_df") + + expected_colnames <- c( + "geography_id", "series_id", "counterpart_id", "year", "value" + ) + expect_equal(colnames(result), expected_colnames) + + expected_coltypes <- c( + "character", "character", "character", "integer", "numeric" + ) + expect_true(all(lapply(result, class) == expected_coltypes)) })