Merge pull request #176 from r-lib/pagination

R/gh.R

@@ -26,7 +26,7 @@
 #'   values are silently dropped. For GET requests, named `NA` values trigger an
 #'   error. For other methods, named `NA` values are included in the body of the
 #'   request, as JSON `null`.
-#' @param per_page Number of items to return per page. If omitted,
+#' @param per_page,.per_page Number of items to return per page. If omitted,
 #'   will be substituted by `max(.limit, 100)` if `.limit` is set,
 #'   otherwise determined by the API (never greater than 100).
 #' @param .destfile Path to write response to disk. If `NULL` (default),
@@ -157,6 +157,7 @@
 gh <- function(endpoint,
                ...,
                per_page = NULL,
+               .per_page = NULL,
                .token = NULL,
                .destfile = NULL,
                .overwrite = FALSE,
@@ -172,12 +173,12 @@ gh <- function(endpoint,
   params <- c(list(...), .params)
   params <- drop_named_nulls(params)
 
-  if (is.null(per_page)) {
-    if (!is.null(.limit)) {
-      per_page <- max(min(.limit, 100), 1)
-    }
-  }
 
+  check_exclusive(per_page, .per_page, .require = FALSE)
+  per_page <- per_page %||% .per_page
+  if (is.null(per_page) && !is.null(.limit)) {
+    per_page <- max(min(.limit, 100), 1)
+  }
   if (!is.null(per_page)) {
     params <- c(params, list(per_page = per_page))
   }
@@ -198,15 +199,20 @@ gh <- function(endpoint,
 
   if (req$method == "GET") check_named_nas(params)
 
-  if (.progress) prbr <- make_progress_bar(req)
-
   raw <- gh_make_request(req)
   res <- gh_process_response(raw, req)
   len <- gh_response_length(res)
 
+  if (.progress && !is.null(.limit)) {
+    pages <- min(gh_extract_pages(res), ceiling(.limit / per_page))
+    cli::cli_progress_bar("Running gh query", total = pages)
+    cli::cli_progress_update() # already done one
+  }
+
   while (!is.null(.limit) && len < .limit && gh_has_next(res)) {
-    if (.progress) update_progress_bar(prbr, res)
     res2 <- gh_next(res)
+    len <- len + gh_response_length(res2)
+    if (.progress) cli::cli_progress_update()
 
     if (!is.null(names(res2)) && identical(names(res), names(res2))) {
       res3 <- mapply( # Handle named array case
@@ -228,12 +234,12 @@ gh <- function(endpoint,
       res3 <- c(res, res2) # e.g. GET /orgs/:org/invitations
     }
 
-    len <- len + gh_response_length(res2)
-
     attributes(res3) <- attributes(res2)
     res <- res3
   }
 
+  if (.progress) cli::cli_progress_done()
+
   # We only subset for a non-named response.
   if (!is.null(.limit) && len > .limit &&
     !"total_count" %in% names(res) && length(res) == len) {

R/pagination.R

@@ -52,9 +52,7 @@ gh_link <- function(gh_response, link) {
 
 gh_extract_pages <- function(gh_response) {
   last <- extract_link(gh_response, "last")
-  if (grepl("&page=[0-9]+$", last)) {
-    as.integer(sub("^.*page=([0-9]+)$", "\\1", last))
-  }
+  as.integer(httr2::url_parse(last)$query$page)
 }
 
 #' Get the next, previous, first or last page of results
@@ -96,40 +94,3 @@ gh_first <- function(gh_response) gh_link(gh_response, "first")
 #' @export
 
 gh_last <- function(gh_response) gh_link(gh_response, "last")
-
-make_progress_bar <- function(gh_request) {
-  state <- new.env(parent = emptyenv())
-  state$pageno <- 0L
-  state$got <- 0L
-  state$status <- NULL
-  state
-}
-
-update_progress_bar <- function(state, gh_response) {
-  state$pageno <- state$pageno + 1L
-  state$got <- gh_response_length(gh_response)
-  state$pages <- gh_extract_pages(gh_response) %||% state$pages
-
-  if (is.null(state$status)) {
-    state$status <- cli_status(
-      "{.alert-info Running gh query}",
-      .envir = parent.frame()
-    )
-  }
-
-  total <- NULL
-  if (!is.null(state$pages)) {
-    est <- state$pages * (state$got / state$pageno)
-    if (est >= state$got) total <- est
-  }
-
-  cli_status_update(
-    state$status,
-    c(
-      "{.alert-info Running gh query, got {state$got} record{?s}}",
-      if (!is.null(total)) " of about {total}"
-    )
-  )
-
-  invisible(state)
-}

tests/testthat/_snaps/gh.md

@@ -8,3 +8,11 @@
       x URL not found: <https://api.github.com/missing>
       i Read more at <https://docs.github.com/rest>
 
+# can use per_page or .per_page but not both
+
+    Code
+      gh("/orgs/tidyverse/repos", per_page = 1, .per_page = 2)
+    Condition
+      Error in `gh()`:
+      ! Exactly one of `per_page` or `.per_page` must be supplied.
+

tests/testthat/_snaps/pagination.md

@@ -0,0 +1,8 @@
+# can extract relative pages
+
+    Code
+      gh_prev(page1)
+    Condition
+      Error in `gh_link_request()`:
+      ! No prev page
+

tests/testthat/test-gh.R

@@ -51,3 +51,37 @@ test_that("can catch a given status directly", {
   expect_s3_class(e, "github_error")
   expect_s3_class(e, "http_error_404")
 })
+
+test_that("can use per_page or .per_page but not both", {
+  skip_on_cran()
+  resp <- gh("/orgs/tidyverse/repos", per_page = 2)
+  expect_equal(attr(resp, "request")$query$per_page, 2)
+
+  resp <- gh("/orgs/tidyverse/repos", .per_page = 2)
+  expect_equal(attr(resp, "request")$query$per_page, 2)
+
+  expect_snapshot(
+    error = TRUE,
+    gh("/orgs/tidyverse/repos", per_page = 1, .per_page = 2)
+  )
+})
+
+test_that("can paginate", {
+  skip_on_cran()
+  pages <- gh("/orgs/tidyverse/repos", per_page = 1, .limit = 5, .progress = FALSE)
+  expect_length(pages, 5)
+})
+
+test_that("trim output when .limit isn't a multiple of .per_page", {
+  skip_on_cran()
+  pages <- gh("/orgs/tidyverse/repos", per_page = 2, .limit = 3, .progress = FALSE)
+  expect_length(pages, 3)
+})
+
+test_that("can paginate repository search", {
+  skip_on_cran()
+  pages <- gh("/search/repositories", q = "tidyverse", per_page = 10, .limit = 35)
+  expect_named(pages, c("total_count", "incomplete_results", "items"))
+  # Eliminates aren't trimmed to .limit in this case
+  expect_length(pages$items, 40)
+})

tests/testthat/test-gh_response.R

@@ -49,19 +49,21 @@ test_that("can download files", {
 })
 
 test_that("warns if output is HTML", {
+  skip_on_cran()
   expect_snapshot(res <- gh("POST /markdown", text = "foo"))
 
   expect_equal(res, list(message = "<p>foo</p>\n"), ignore_attr = TRUE)
   expect_equal(class(res), c("gh_response", "list"))
 })
 
 test_that("captures details to recreate request", {
+  skip_on_cran()
   res <- gh("/orgs/{org}/repos", org = "r-lib", .per_page = 1)
 
   req <- attr(res, "request")
   expect_type(req, "list")
   expect_equal(req$url, "https://api.github.com/orgs/r-lib/repos")
-  expect_equal(req$query, list(.per_page = 1))
+  expect_equal(req$query, list(per_page = 1))
 
   # For backwards compatibility
   expect_equal(attr(res, "method"), "GET")

tests/testthat/test-pagination.R

@@ -1,4 +1,21 @@
+test_that("can extract relative pages", {
+  skip_on_cran()
+  page1 <- gh("/orgs/tidyverse/repos", per_page = 1)
+  expect_true(gh_has(page1, "next"))
+  expect_false(gh_has(page1, "prev"))
+
+  page2 <- gh_next(page1)
+  expect_equal(
+    attr(page2, "request")$url,
+    "https://api.github.com/organizations/22032646/repos?per_page=1&page=2"
+  )
+  expect_true(gh_has(page2, "prev"))
+
+  expect_snapshot(gh_prev(page1), error = TRUE)
+})
+
 test_that("paginated request gets max_wait and max_rate", {
+  skip_on_cran()
   gh <- gh("/orgs/tidyverse/repos", per_page = 5, .max_wait = 1, .max_rate = 10)
 
   req <- gh_link_request(gh, "next")

tests/testthat/test-print.R

@@ -1,4 +1,5 @@
 test_that("can print all types of object", {
+  skip_on_cran()
   get_license <- function(...) {
     gh(
       "GET /repos/{owner}/{repo}/contents/{path}",