Merge pull request #33 from Teal-Insights/32-add-test-coverageyaml-wo…

…rkflow

Add test-coverage.yaml workflow

.github/workflows/test-coverage.yaml

@@ -0,0 +1,61 @@
+# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples
+# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
+on:
+  push:
+    branches: [main, master]
+  pull_request:
+
+name: test-coverage.yaml
+
+permissions: read-all
+
+jobs:
+  test-coverage:
+    runs-on: ubuntu-latest
+    env:
+      GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+
+    steps:
+      - uses: actions/checkout@v4
+
+      - uses: r-lib/actions/setup-r@v2
+        with:
+          use-public-rspm: true
+
+      - uses: r-lib/actions/setup-r-dependencies@v2
+        with:
+          extra-packages: any::covr, any::xml2
+          needs: coverage
+
+      - name: Test coverage
+        run: |
+          cov <- covr::package_coverage(
+            quiet = FALSE,
+            clean = FALSE,
+            install_path = file.path(normalizePath(Sys.getenv("RUNNER_TEMP"), winslash = "/"), "package")
+          )
+          covr::to_cobertura(cov)
+        shell: Rscript {0}
+
+      - uses: codecov/codecov-action@v4
+        with:
+          # Fail if error if not on PR, or if on PR and token is given
+          fail_ci_if_error: ${{ github.event_name != 'pull_request' || secrets.CODECOV_TOKEN }}
+          file: ./cobertura.xml
+          plugin: noop
+          disable_search: true
+          token: ${{ secrets.CODECOV_TOKEN }}
+
+      - name: Show testthat output
+        if: always()
+        run: |
+          ## --------------------------------------------------------------------
+          find '${{ runner.temp }}/package' -name 'testthat.Rout*' -exec cat '{}' \; || true
+        shell: bash
+
+      - name: Upload test results
+        if: failure()
+        uses: actions/upload-artifact@v4
+        with:
+          name: coverage-test-failures
+          path: ${{ runner.temp }}/package

DESCRIPTION

@@ -35,7 +35,7 @@ Suggests:
     languageserver (>= 0.3.16)
 Config/testthat/edition: 3
 URL: https://teal-insights.github.io/r-wbids, https://github.com/teal-insights/r-wbids
-BugReports: https://github.com/Teal-Insights/r-wbids/issues
+BugReports: https://github.com/teal-insights/r-wbids/issues
 VignetteBuilder: quarto
 Remotes: 
     r-lib/devtools,

NAMESPACE

@@ -12,6 +12,7 @@ import(cli)
 import(dplyr)
 import(httr2)
 importFrom(purrr,map)
+importFrom(purrr,map_df)
 importFrom(rlang,eval_tidy)
 importFrom(rlang,parse_expr)
 importFrom(tidyr,crossing)

R/ids_bulk.R

@@ -43,23 +43,20 @@ ids_bulk <- function(
   timeout = getOption("timeout", 60),
   warn_size = TRUE
 ) {
+
   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)
 
-  # Read and process the data
-  if (!quiet) message("Reading in file.")
+  if (!quiet) cli::cli_progress_message("Reading in file.")
   bulk_data <- read_bulk_file(file_path)
 
-  if (!quiet) message("Processing file.")
+  if (!quiet) cli::cli_progress_message("Processing file.")
   bulk_data <- process_bulk_data(bulk_data)
 
-  # Return the processed data
-  return(bulk_data)
+  bulk_data
 }
 
 #' Get response headers from a URL
@@ -81,60 +78,52 @@ get_response_headers <- function(file_url) {
 #' @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)
+  formatted_size <- format(round(size_mb, 1), nsmall = 1) # nolint
 
   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
+    cli::cli_warn(paste0(
+      "This file is {formatted_size} MB and may take several minutes to ",
+      "download. Current timeout setting: {timeout} seconds. Use ",
+      "{.code warn_size = FALSE} to disable this warning."
+    ))
+
     if (warn_size && check_interactive()) {
-      response <- readline("Do you want to continue with the download? (y/N): ")
+      response <- prompt_user(
+        "Do you want to continue with the download? (y/N): "
+      )
       if (!tolower(response) %in% c("y", "yes")) {
-        stop("Download cancelled by user", call. = FALSE)
+        cli::cli_abort("Download cancelled by user")
       }
     }
   }
 
-  # Print message about file download
-  if (!quiet) message("Downloading file to: {file_path}")
+  if (!quiet) {
+    cli::cli_progress_message("Downloading file to: {file_path}")
+  }
 
-  # Download with timeout handling
+  # nocov start
   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(
+        cli::cli_abort(
           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)
+      cli::cli_abort(e$message)
     })
   )
-
-  # Validate downloaded file
+  # nocov end
   validate_file(file_path)
 }
 
@@ -143,11 +132,11 @@ download_bulk_file <- function(file_url, file_path, timeout, warn_size, quiet) {
 #' @param file_path Path to file to validate
 validate_file <- function(file_path) {
   if (!file.exists(file_path)) {
-    stop("Download failed: File not created")
+    cli::cli_abort("Download failed: File not created")
   }
   if (file.size(file_path) == 0) {
     unlink(file_path)
-    stop("Download failed: Empty file")
+    cli::cli_abort("Download failed: Empty file")
   }
 }
 
@@ -215,3 +204,13 @@ check_interactive <- function() {
 download_file <- function(url, destfile, quiet) {
   utils::download.file(url, destfile = destfile, quiet = quiet, mode = "wb")
 }
+
+#' Prompt a user with a question
+#'
+#' Wrapper around base::readline to facilitate testing. Cannot be tested
+#' because of the base binding.
+#'
+#' @keywords internal
+prompt_user <- function(prompt) {
+  readline(prompt) # nocov
+}

R/ids_bulk_files.R

@@ -19,16 +19,7 @@
 #'
 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",
-      "?dataset_unique_id=0038015&version_id="
-    )
-  )
+  ids_meta <- read_bulk_info()
 
   bulk_files <- ids_meta$resources |>
     as_tibble() |>

R/ids_bulk_series.R

@@ -24,16 +24,7 @@
 #'
 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",
-      "?dataset_unique_id=0038015&version_id="
-    )
-  )
+  ids_meta <- read_bulk_info()
 
   bulk_series <- ids_meta$indicators |>
     as_tibble() |>

R/ids_get.R

@@ -122,62 +122,54 @@ get_debt_statistics <- function(
 
   series_raw <- perform_request(resource, progress = progress_message)
 
-  series_raw_rbind <- series_raw$data |>
-    bind_rows()
-
-  # Since the order of list items changes across series, we cannot use
-  # hard-coded list paths
-  series_wide <- series_raw_rbind |>
-    select("variable") |>
-    tidyr::unnest_wider("variable")
-
-  geography_ids <- series_wide |>
-    filter(.data$concept == "Country") |>
-    select(geography_id = "id")
-
-  series_ids <- series_wide |>
-    filter(.data$concept == "Series") |>
-    select(series_id = "id")
-
-  counterpart_ids <- series_wide |>
-    filter(.data$concept == "Counterpart-Area") |>
-    select(counterpart_id = "id")
-
-  years <- series_wide |>
-    filter(.data$concept == "Time") |>
-    select(year = "value") |>
-    mutate(year = as.integer(.data$year))
-
-  values <- extract_values(series_raw$data, "value", "numeric")
-
-  bind_cols(
-    geography_ids,
-    series_ids,
-    counterpart_ids,
-    years,
-    value = values
-  )
-}
-
-extract_values <- function(data, path, type = "character") {
-  path_expr <- rlang::parse_expr(path)
-
-  fun_value <- switch(
-    type,
-    "character" = NA_character_,
-    "integer" = NA_integer_,
-    "numeric" = NA_real_,
-    stop("Invalid type. Must be one of 'character', 'integer', or 'numeric'.")
-  )
+  if (length(series_raw[[1]]$variable[[1]]$concept) == 0) {
+    tibble(
+      "geography_id" = character(),
+      "series_id" = character(),
+      "counterpart_id" = character(),
+      "year" = integer(),
+      "value" = numeric()
+    )
+  } else {
+    series_raw_rbind <- series_raw |>
+      bind_rows()
+
+    # Since the order of list items changes across series, we cannot use
+    # hard-coded list paths
+    series_wide <- series_raw_rbind |>
+      select("variable") |>
+      tidyr::unnest_wider("variable")
+
+    geography_ids <- series_wide |>
+      filter(.data$concept == "Country") |>
+      select(geography_id = "id")
+
+    series_ids <- series_wide |>
+      filter(.data$concept == "Series") |>
+      select(series_id = "id")
+
+    counterpart_ids <- series_wide |>
+      filter(.data$concept == "Counterpart-Area") |>
+      select(counterpart_id = "id")
+
+    years <- series_wide |>
+      filter(.data$concept == "Time") |>
+      select(year = "value") |>
+      mutate(year = as.integer(.data$year))
+
+    values <- series_raw |>
+      purrr::map_df(
+        \(x) tibble(value = if (is.null(x$value)) NA_real_ else x$value)
+      )
 
-  vapply(data, function(x) {
-    result <- rlang::eval_tidy(path_expr, x)
-    if (is.null(result) || length(result) == 0) {
-      fun_value
-    } else {
-      result
-    }
-  }, FUN.VALUE = fun_value, USE.NAMES = FALSE)
+    bind_cols(
+      geography_ids,
+      series_ids,
+      counterpart_ids,
+      years,
+      values
+    )
+  }
 }
 
 validate_character_vector <- function(arg, arg_name) {

R/ids_list_geographies.R

@@ -7,7 +7,8 @@
 #'
 #' @return A tibble containing the available geographies and their attributes:
 #' \describe{
-#'   \item{geography_id}{The unique identifier for the geography (e.g., "ZMB").}
+#'   \item{geography_id}{ISO 3166-1 alpha-3 code of the geography (e.g.,
+#'                       "ZMB").}
 #'   \item{geography_name}{The standardized name of the geography (e.g.,
 #'                         "Zambia").}
 #'   \item{geography_iso2code}{ISO 3166-1 alpha-2 code of the geography (e.g.,