Merge pull request #75 from worldbank/httr2_gc_2

fixes to httr2, new endpoints, nowcast, attempt 2

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: pipr
 Title: Client for the Poverty and Inequality Platform ('PIP') API
-Version: 1.0.0
+Version: 1.1.0
 Authors@R: 
     c(person(given = "Tony",
             family = "Fujs",
@@ -28,7 +28,7 @@ License: MIT + file LICENSE
 Encoding: UTF-8
 LazyData: true
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.2
 URL: https://worldbank.github.io/pipr/, 
     https://github.com/worldbank/pipr, 
     <https://pip.worldbank.org/api>
@@ -41,7 +41,6 @@ Suggests:
     rmarkdown,
     markdown,
     callr,
-    mockery,
     ggplot2,
     tidyr,
     ggthemes,
@@ -50,20 +49,20 @@ Suggests:
     dplyr,
     readr
 Language: en-US
-Imports: 
+Imports:
+    arrow,
     attempt,
     curl,
-    httr,
     jsonlite,
     tibble,
     purrr,
-    memoise,
-    cachem,
-    data.table,
     cli,
     rlang,
-    utils
+    utils,
+    httr2,
+    stringr,
+    vroom
 Depends: 
-    R (>= 3.6.0)
+    R (>= 4.1.0)
 Config/testthat/edition: 3
 Date: 2023-04-28

NAMESPACE

@@ -1,9 +1,15 @@
 # Generated by roxygen2: do not edit by hand
 
 export(call_aux)
+export(change_grouped_stats_to_csv)
 export(check_api)
+export(delete_cache)
 export(display_aux)
 export(get_aux)
+export(get_cache_info)
+export(get_cp)
+export(get_cp_ki)
+export(get_gd)
 export(get_pip_info)
 export(get_stats)
 export(get_versions)

NEWS.md

@@ -1,3 +1,13 @@
+# pipr 1.1.0
+
+* [Use httr2](https://github.com/worldbank/pipr/pull/70)
+  * API responses are now cached locally according to the PIP API cache policy
+  from the PIP API responses headers
+  * `pipr` automatically handles retries when hitting the PIP API rate limiting
+  threshold
+  * Improved translation of HTTP errors into R error messages
+* New helper functions `delete_cache()` and `get_cache_info()`
+
 # pipr 1.0.0
 
 * [Mock live API calls or skip them on CRAN](https://github.com/worldbank/pipr/pull/45)

R/aaa.R

@@ -1,23 +1,24 @@
-.pip <-  new.env(parent = emptyenv())
+.pip      <-  new.env(parent = emptyenv()) # PR 63
+.pipcache <-  new.env(parent = emptyenv()) # PR 63
 
 
 #' Set auxiliary table in .pip environment for later call
 #'
 #' @param table character: name of the table in .pip env
 #' @param value data to be saved
-#' @inheritParams get_aux
+#' @param replace logical.
 #'
 #' @return Invisible TRUE if set correctly. FALSE otherwise
 #' @keywords internal
 set_aux <- function(table,
                     value,
-                    force = FALSE) {
+                    replace = FALSE) { # PR 63
   #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   ## Evaluate if exists --------
 
   to_set <-  1
   if (rlang::env_has(.pip, table)) {
-    if (force == FALSE) {
+    if (isFALSE(replace)) { # PR 63
       cli::cli_alert("Table {.field {table}} already exists.")
       to_set <- utils::menu(c("Replace with new table", "Abort"))
     }
@@ -65,12 +66,12 @@ set_aux <- function(table,
 #' @examples
 #' # call one table
 #'
-#' get_aux("gdp", assign_tb = TRUE, force = TRUE)
+#' get_aux("gdp", assign_tb = TRUE, replace = TRUE) # PR 63
 #' call_aux("gdp")
 #'
 #' # see the name of several tables in memory
 #' tb <- c("cpi", "ppp", "pop")
-#' lapply(tb, get_aux, assign_tb = TRUE, force = TRUE)
+#' lapply(tb, get_aux, assign_tb = TRUE, replace = TRUE) # PR 63
 #' call_aux()
 call_aux <- function(table = NULL) {
 
@@ -119,7 +120,9 @@ call_aux <- function(table = NULL) {
       return(rlang::env_get(.pip, table))
     } else {
       msg     <- c("*" = "Table {.field {table}} does not exist")
-      cli::cli_abort(msg, wrap = TRUE)
+      cli::cli_abort(msg,
+
+                     wrap = TRUE)
     }
 
   }

R/build_request.R

@@ -0,0 +1,88 @@
+#' Build request version 2
+#'
+#' @param server character: Server. For WB internal use only
+#' @param api_version character: API version
+#' @param endpoint character: PIP API endpoint
+#' @param ... other parameters
+#'
+#' @return httr2 request
+#'
+build_request <- function(server,
+                          api_version,
+                          endpoint,
+                          ...) {
+
+
+
+  base_url <- select_base_url(server = server)
+  params <- list(...)
+
+  req <- httr2::request(base_url) |>
+    httr2::req_url_path_append(api_version) |>
+    httr2::req_url_path_append(endpoint) |>
+    # .multi = "comma" works fine without applying fix_params
+    httr2::req_url_query(!!!params, .multi = "comma") |>
+    httr2::req_cache(tools::R_user_dir("pipr", which = "cache"),
+                     use_on_error = TRUE,
+                     debug = TRUE) |>
+    httr2::req_user_agent(pipr_user_agent) |>
+    httr2::req_error(body = parse_error_body) |>
+    httr2::req_retry(
+      is_transient = pip_is_transient,
+      after = retry_after,
+      max_seconds = 60
+    )
+
+
+  return(req)
+
+}
+
+
+
+
+#' build_request, OLD version
+#'
+#' @param server character: Server. For WB internal use only
+#' @param api_version character: API version
+#' @param endpoint character: PIP API endpoint
+#' @param ... other parameters
+#'
+#' @return httr2 request
+#'
+build_request_old <- function(server,
+                          api_version,
+                          endpoint,
+                          ...) {
+
+  base_url <- select_base_url(server = server)
+
+  params <- list(...)
+  params <- lapply(params, fix_params)
+
+  req <- httr2::request(base_url) |>
+    httr2::req_url_path_append(api_version) |>
+    httr2::req_url_path_append(endpoint) |>
+    httr2::req_url_query(!!!params) |>
+    httr2::req_cache(tools::R_user_dir("pipr", which = "cache"),
+                     use_on_error = TRUE,
+                     debug = TRUE) |>
+    httr2::req_user_agent(pipr_user_agent) |>
+    httr2::req_error(body = parse_error_body) |>
+    httr2::req_retry(
+      is_transient = pip_is_transient,
+      after = retry_after,
+      max_seconds = 60
+    )
+
+  return(req)
+
+}
+
+fix_params <- function(param) {
+  if (length(param) > 1) {
+    return(paste(param, collapse = ","))
+  } else {
+    return(param)
+  }
+}

R/data.R

@@ -0,0 +1,36 @@
+#' Datt (1998) grouped data for rural india, 1983
+#'
+#' Dataset from Datt (1998) with grouped data for rural India in 1983.
+#'
+#' @format A data frame with 13 observations on the following 6 variables:
+#' \describe{
+#'  \item{monthly_pc_exp}{Welfare range class}
+#'  \item{mean_monthly_pc_exp}{Mean welfare for given welfare range class}
+#'  \item{percentage_of_persons}{Percentage of individuals in given welfare class}
+#'   \item{L}{Cumulative welfare}
+#'  \item{p}{Cumulative population}
+#'  \item{area}{rural}
+#'  }
+#'
+#'  @source Datt, G. (1998). See get_cp vignette.
+#'
+"datt_rural"
+
+#' Grouped data for urban india, 1983
+#'
+#' Dataset from Sarvekshana N26 Vol 9 N 4, created by the author following
+#' Datt(1998) methodology with grouped data for urban India in 1983.
+#'
+#' @format A data frame with 13 observations on the following 6 variables:
+#' \describe{
+#'  \item{monthly_pc_exp}{Welfare range class}
+#'  \item{mean_monthly_pc_exp}{Mean welfare for given welfare range class}
+#'  \item{percentage_of_persons}{Percentage of individuals in given welfare class}
+#'   \item{L}{Cumulative welfare}
+#'  \item{p}{Cumulative population}
+#'  \item{area}{urban}
+#'  }
+#'
+#'  @source Sarvekshana N26 Vol 9 N 4, and Datt, G. (1998) for methodology. See get_cp vignette.
+#'
+"datt_urban"

R/display_aux.R

@@ -31,9 +31,12 @@ display_aux <- function(version         = NULL,
 
 #   ____________________________________________________________________________
 #   Build query string                                                  ####
+  req <- build_request(server = server,
+                       api_version = api_version,
+                       endpoint = "aux")
+  res <- req |>
+    httr2::req_perform()
 
-  u      <- build_url(server, "aux", api_version = api_version)
-  res    <- httr::GET(u)
   tbs_tb <- parse_response(res, simplify = simplify)
   tbs    <- tbs_tb[["tables"]]
   if (isTRUE(run_cli)) {

R/get_aux.R

@@ -13,7 +13,8 @@
 #'   assigned to  exactly the same name as the one of the desired table. If
 #'   character, the table will be assigned to that name.
 #' @inheritParams get_stats
-#' @param force logical: force replacement. Default is FALSE
+#' @param replace logical: force replacement of aux files in `.pip` env. Default
+#'   is FALSE.
 #'
 #' @return If `simplify = FALSE`, it returns a list of class "pip_api". If
 #'   `simplify = TRUE`, it returns a tibble with the requested data. This is the
@@ -54,19 +55,22 @@ get_aux <- function(table           = NULL,
                     simplify        = TRUE,
                     server          = NULL,
                     assign_tb       = FALSE,
-                    force           = FALSE) {
+                    replace         = FALSE) {
 
   # Match args
   api_version <- match.arg(api_version)
   format      <- match.arg(format)
   run_cli     <- run_cli()
   # Build query string
-  u <- build_url(server, "aux", api_version = api_version)
+  req <- build_request(server = server,
+                       api_version = api_version,
+                       endpoint = "aux")
 
   # Return response
   # If no table is specified, returns list of available tables
   if (is.null(table)) {
-    res <- httr::GET(u)
+    res <- req |>
+      httr2::req_perform()
     tables <- parse_response(res, simplify = simplify)
     cli::cli_text("Auxiliary tables available are")
     cli::cli_ul(tables$tables)
@@ -80,12 +84,15 @@ get_aux <- function(table           = NULL,
     return(invisible(tables))
   # If a table is specified, returns that table
   } else {
-    args <- build_args(.table = table,
-                       .version = version,
-                       .ppp_version = ppp_version,
-                       .release_version = release_version,
-                       .format = format)
-    res <- httr::GET(u, query = args, httr::user_agent(pipr_user_agent))
+    req <- build_request(server          = server,
+                         api_version     = api_version,
+                         endpoint        = "aux",
+                         table           = table,
+                         version         = version,
+                         release_version = release_version,
+                         format          = format)
+
+    res <- httr2::req_perform(req)
     rt  <- parse_response(res, simplify = simplify)
   }
 
@@ -107,7 +114,7 @@ get_aux <- function(table           = NULL,
 
     srt <- set_aux(table = tb_name,
                    value = rt,
-                   force = force)
+                   replace = replace)
 
     if (isTRUE(srt)) {