Return partial results in the condition on interrupt

NEWS.md

@@ -1,5 +1,12 @@
 # gh (development version)
 
+* `gh()` now signals a classed `gh_interrupt` interrupt when a paginated
+  call is interrupted (e.g. via `Ctrl+C` / `Escape`). The condition object
+  carries the records fetched so far on its `$gh_result` field. If the
+  interrupt is not caught, then you can also access it via
+  `rlang::last_error()`, i.e. the partial results are in
+  `rlang::last_error()$gh_result` (#98).
+
 * GitHub PAT format validation now issues a warning by default instead of
   throwing an error, so a PAT in an unrecognized (e.g. newly introduced)
   format is still used. Set the `gh_validate_tokens` option or the

R/gh.R

@@ -286,60 +286,98 @@ gh_paginate <- function(
 
   res <- NULL
   cur_req <- httr2_req
-  repeat {
-    page <- page + 1L
-    resp <- httr2::req_perform(cur_req)
-    if (httr2::resp_status(resp) >= 400) {
-      gh_error(resp, gh_req = gh_req, error_call = error_call)
-    }
-    res2 <- gh_process_response(resp, gh_req)
-    n_items <- n_items + gh_response_length(res2)
-    res <- if (is.null(res)) res2 else gh_merge_pages(res, res2)
-
-    # After page 1: discover total from the "last" link if available, then
-    # swap the initial spinner for the appropriate final progress bar.
-    if (page == 1L) {
-      if (is.na(display_total)) {
-        last_url <- httr2::resp_link_url(resp, "last")
-        if (!is.null(last_url)) {
-          last_page <- as.integer(httr2::url_parse(last_url)$query$page)
-          if (!is.na(last_page)) {
-            display_pages <- last_page
-            display_total <- last_page * per_page
+  tryCatch(
+    repeat {
+      page <- page + 1L
+      resp <- httr2::req_perform(cur_req)
+      if (httr2::resp_status(resp) >= 400) {
+        gh_error(resp, gh_req = gh_req, error_call = error_call)
+      }
+      res2 <- gh_process_response(resp, gh_req)
+      n_items <- n_items + gh_response_length(res2)
+      res <- if (is.null(res)) res2 else gh_merge_pages(res, res2)
+
+      # After page 1: discover total from the "last" link if available, then
+      # swap the initial spinner for the appropriate final progress bar.
+      if (page == 1L) {
+        if (is.na(display_total)) {
+          last_url <- httr2::resp_link_url(resp, "last")
+          if (!is.null(last_url)) {
+            last_page <- as.integer(httr2::url_parse(last_url)$query$page)
+            if (!is.na(last_page)) {
+              display_pages <- last_page
+              display_total <- last_page * per_page
+            }
           }
         }
+        if (isTRUE(.progress)) {
+          cli::cli_progress_done()
+          cli::cli_progress_bar(
+            total = if (is.na(display_total)) NA else display_total,
+            format = if (is.na(display_total)) {
+              fmt_indeterminate
+            } else {
+              fmt_determinate
+            },
+            clear = TRUE,
+            .envir = environment()
+          )
+        }
       }
+
       if (isTRUE(.progress)) {
-        cli::cli_progress_done()
-        cli::cli_progress_bar(
-          total = if (is.na(display_total)) NA else display_total,
-          format = if (is.na(display_total)) {
-            fmt_indeterminate
-          } else {
-            fmt_determinate
-          },
-          clear = TRUE,
-          .envir = environment()
+        cli::cli_progress_update(
+          set = if (is.na(display_total)) NULL else min(n_items, display_total),
+          force = TRUE
         )
       }
-    }
 
-    if (isTRUE(.progress)) {
-      cli::cli_progress_update(
-        set = if (is.na(display_total)) NULL else min(n_items, display_total),
-        force = TRUE
+      if (page >= max_reqs) {
+        break
+      }
+      nxt <- next_url(resp, cur_req)
+      if (is.null(nxt)) {
+        break
+      }
+      cur_req <- nxt
+    },
+    interrupt = function(e) {
+      if (isTRUE(.progress)) {
+        cli::cli_progress_done() # nocov
+      }
+      cond <- structure(
+        class = c("gh_interrupt", "interrupt", "condition"),
+        list(
+          message = cli::format_inline(
+            "{.fn gh} interrupted after fetching {n_items} record{?s}."
+          ),
+          call = error_call,
+          gh_result = res
+        )
+      )
+      withRestarts(
+        {
+          signalCondition(cond)
+          # No exiting handler claimed it. Stash for `rlang::last_error()`
+          # recovery, then propagate as a real interrupt.
+          asNamespace("rlang")$poke_last_error(cond) # nocov
+          # nocov start
+          cli::cli_inform(
+            c(
+              "!" = cond$message,
+              "i" = paste(
+                "Partial results are available in",
+                "{.code rlang::last_error()$gh_result}."
+              )
+            )
+          )
+          # nocov end
+          rlang::interrupt() # nocov
+        },
+        muffle_gh_interrupt = function() invisible(NULL)
       )
     }
-
-    if (page >= max_reqs) {
-      break
-    }
-    nxt <- next_url(resp, cur_req)
-    if (is.null(nxt)) {
-      break
-    }
-    cur_req <- nxt
-  }
+  )
 
   attr(res, "gh_pagination_length") <- n_items
   res

tests/testthat/test-pagination.R

@@ -43,6 +43,68 @@ test_that("gh_link_request errors on non-gh_response input", {
   )
 })
 
+test_that("interrupt during pagination signals gh_interrupt with partial data", {
+  local_fake_github()
+
+  original_process <- gh_process_response
+  call_count <- 0L
+  fake_process <- function(resp, gh_req) {
+    call_count <<- call_count + 1L
+    if (call_count >= 2L) {
+      rlang::interrupt()
+    }
+    original_process(resp, gh_req)
+  }
+  local_mocked_bindings(gh_process_response = fake_process)
+
+  cond <- tryCatch(
+    gh("/orgs/tidyverse/repos", per_page = 1, .limit = 5, .progress = FALSE),
+    gh_interrupt = function(e) e
+  )
+  expect_s3_class(cond, "gh_interrupt")
+  expect_s3_class(cond, "interrupt")
+  expect_s3_class(cond$gh_result, "gh_response")
+  expect_length(cond$gh_result, 1L)
+})
+
+test_that("generic interrupt handler also receives gh_result", {
+  local_fake_github()
+
+  original_process <- gh_process_response
+  call_count <- 0L
+  fake_process <- function(resp, gh_req) {
+    call_count <<- call_count + 1L
+    if (call_count >= 2L) {
+      rlang::interrupt()
+    }
+    original_process(resp, gh_req)
+  }
+  local_mocked_bindings(gh_process_response = fake_process)
+
+  cond <- tryCatch(
+    gh("/orgs/tidyverse/repos", per_page = 1, .limit = 5, .progress = FALSE),
+    interrupt = function(e) e
+  )
+  expect_s3_class(cond, "gh_interrupt")
+  expect_s3_class(cond$gh_result, "gh_response")
+})
+
+test_that("interrupt before first page signals gh_interrupt with NULL gh_result", {
+  local_fake_github()
+
+  fake_process <- function(resp, gh_req) {
+    rlang::interrupt()
+  }
+  local_mocked_bindings(gh_process_response = fake_process)
+
+  cond <- tryCatch(
+    gh("/orgs/tidyverse/repos", per_page = 1, .limit = 5, .progress = FALSE),
+    gh_interrupt = function(e) e
+  )
+  expect_s3_class(cond, "gh_interrupt")
+  expect_null(cond$gh_result)
+})
+
 test_that("paginated request gets max_wait and max_rate", {
   local_fake_github()
   gh <- gh(