1#' Helpers for GitHub pull requests 2#' 3#' @description 4#' The `pr_*` family of functions is designed to make working with GitHub pull 5#' requests (PRs) as painless as possible for both contributors and package 6#' maintainers. 7#' 8#' To use the `pr_*` functions, your project must be a Git repo and have one of 9#' these GitHub remote configurations: 10#' * "ours": You can push to the GitHub remote configured as `origin` and it's 11#' not a fork. 12#' * "fork": You can push to the GitHub remote configured as `origin`, it's a 13#' fork, and its parent is configured as `upstream`. `origin` points to your 14#' **personal** copy and `upstream` points to the **source repo**. 15#' 16#' "Ours" and "fork" are two of several GitHub remote configurations examined in 17#' [Common remote setups](https://happygitwithr.com/common-remote-setups.html) 18#' in Happy Git and GitHub for the useR. 19#' 20#' The [Pull Request 21#' Helpers](https://usethis.r-lib.org/articles/articles/pr-functions.html) 22#' article walks through the process of making a pull request with the `pr_*` 23#' functions. 24#' 25#' The `pr_*` functions also use your Git/GitHub credentials to carry out 26#' various remote operations. See below for more. 27#' 28#' @template double-auth 29#' 30#' @section For contributors: 31#' To contribute to a package, first use `create_from_github("OWNER/REPO")` to 32#' fork the source repository, and then check out a local copy. 33#' 34#' Next use `pr_init()` to create a branch for your PR. It is best practice to 35#' never make commits to the default branch branch of a fork (usually named 36#' `main` or `master`), because you do not own it. A pull request should always 37#' come from a feature branch. It will be much easier to pull upstream changes 38#' from the fork parent if you only allow yourself to work in feature branches. 39#' It is also much easier for a maintainer to explore and extend your PR if you 40#' create a feature branch. 41#' 42#' Work locally, in your branch, making changes to files, and committing your 43#' work. Once you're ready to create the PR, run `pr_push()` to push your local 44#' branch to GitHub, and open a webpage that lets you initiate the PR (or draft 45#' PR). 46#' 47#' To learn more about the process of making a pull request, read the [Pull 48#' Request 49#' Helpers](https://usethis.r-lib.org/articles/articles/pr-functions.html) 50#' vignette. 51#' 52#' If you are lucky, your PR will be perfect, and the maintainer will accept it. 53#' You can then run `pr_finish()` to delete your PR branch. In most cases, 54#' however, the maintainer will ask you to make some changes. Make the changes, 55#' then run `pr_push()` to update your PR. 56#' 57#' It's also possible that the maintainer will contribute some code to your PR: 58#' to get those changes back onto your computer, run `pr_pull()`. It can also 59#' happen that other changes have occurred in the package since you first 60#' created your PR. You might need to merge the default branch (usually named 61#' `main` or `master`) into your PR branch. Do that by running 62#' `pr_merge_main()`: this makes sure that your PR is compatible with the 63#' primary repo's main line of development. Both `pr_pull()` and 64#' `pr_merge_main()` can result in merge conflicts, so be prepared to resolve 65#' before continuing. 66#' 67#' @section For maintainers: 68#' To download a PR locally so that you can experiment with it, run 69#' `pr_fetch()` and select the PR or, if you already know its number, call 70#' `pr_fetch(<pr_number>)`. If you make changes, run `pr_push()` to push them 71#' back to GitHub. After you have merged the PR, run `pr_finish()` to delete the 72#' local branch and remove the remote associated with the contributor's fork. 73#' 74#' @section Overview of all the functions: 75 76#' * `pr_init()`: Does a preparatory pull of the default branch from the source 77#' repo, to get a good start point. Creates and checks out a new branch. Nothing 78#' is pushed to or created on GitHub (that does not happen until the first time 79#' you call `pr_push()`). 80 81#' * `pr_resume()`: Resume work on a PR by switching to an existing local branch 82#' and pulling any changes from its upstream tracking branch, if it has one. If 83#' called with no arguments, up to 9 local branches are offered for interactive 84#' selection, with a preference for branches connected to PRs and for branches 85#' with recent activity. 86 87#' * `pr_fetch()`: Checks out a PR on the source repo for local exploration. If 88#' called with no arguments, up to 9 open PRs are offered for interactive 89#' selection. This can cause a new remote to be configured and a new local 90#' branch to be created. The local branch is configured to track its remote 91#' counterpart. The transport protocol (HTTPS vs SSH) for any new remote is 92#' inherited from the remote representing the source repo. `pr_fetch()` puts a 93#' maintainer in a position where they can push changes into an internal or 94#' external PR via `pr_push()`. 95 96#' * `pr_push()`: The first time it's called, a PR branch is pushed to GitHub 97#' and you're taken to a webpage where a new PR (or draft PR) can be created. 98#' This also sets up the local branch to track its remote counterpart. 99#' Subsequent calls to `pr_push()` make sure the local branch has all the remote 100#' changes and, if so, pushes local changes, thereby updating the PR. 101 102#' * `pr_pull()`: Pulls changes from the local branch's remote tracking branch. 103#' If a maintainer has extended your PR, this is how you bring those changes 104#' back into your local work. 105 106#' * `pr_merge_main()`: Pulls changes from the default branch of the source repo 107#' into the current local branch. This can be used when the local branch is the 108#' default branch or when it's a PR branch. 109 110#' * `pr_pause()`: Makes sure you're up-to-date with any remote changes in the 111#' PR. Then switches back to the default branch (usually named `main` or 112#' `master`) and pulls from the source repo. 113 114#' * `pr_view()`: Visits the PR associated with the current branch in the 115#' browser (default) or the specific PR identified by `number`. 116#' (FYI [browse_github_pulls()] is a handy way to visit the list of all PRs for 117#' the current project.) 118 119#' * `pr_forget()`: Does local clean up when the current branch is an actual or 120#' notional PR that you want to abandon. Maybe you initiated it yourself, via 121#' `pr_init()`, or you used `pr_fetch()` to explore a PR from GitHub. Only does 122#' *local* operations: does not update or delete any remote branches, nor does 123#' it close any PRs. Alerts the user to any uncommitted or unpushed work that is 124#' at risk of being lost. If user chooses to proceed, switches back to the 125#' default branch, pulls changes from source repo, and deletes local PR branch. 126#' Any associated Git remote is deleted, if the "forgotten" PR was the only 127#' branch using it. 128 129#' * `pr_finish()`: Does post-PR clean up, but does NOT actually merge or close 130#' a PR (maintainer should do this in the browser). If `number` is not given, 131#' infers the PR from the upstream tracking branch of the current branch. If 132#' `number` is given, it does not matter whether the PR exists locally. If PR 133#' exists locally, alerts the user to uncommitted or unpushed changes, then 134#' switches back to the default branch, pulls changes from source repo, and 135#' deletes local PR branch. If the PR came from an external fork, any associated 136#' Git remote is deleted, provided it's not in use by any other local branches. 137#' If the PR has been merged and user has permission, deletes the remote branch 138#' (this is the only remote operation that `pr_finish()` potentially does). 139#' 140#' @name pull-requests 141NULL 142 143#' @export 144#' @rdname pull-requests 145#' @param branch Name of a new or existing local branch. If creating a new 146#' branch, note this should usually consist of lower case letters, numbers, 147#' and `-`. 148pr_init <- function(branch) { 149 stopifnot(is_string(branch)) 150 repo <- git_repo() 151 152 if (gert::git_branch_exists(branch, local = TRUE, repo = repo)) { 153 code <- glue("pr_resume(\"{branch}\")") 154 ui_info(" 155 Branch {ui_value(branch)} already exists, calling {ui_code(code)}") 156 return(pr_resume(branch)) 157 } 158 159 # don't absolutely require PAT success, because we could be offline 160 # or in another salvageable situation, e.g. need to configure PAT 161 cfg <- github_remote_config(github_get = NA) 162 check_for_bad_config(cfg) 163 tr <- target_repo(cfg, ask = FALSE) 164 165 maybe_good_configs <- c("maybe_ours_or_theirs", "maybe_fork") 166 if (cfg$type %in% maybe_good_configs) { 167 ui_line(' 168 Unable to confirm the GitHub remote configuration is "pull request ready" 169 You probably need to configure a personal access token for \\ 170 {ui_value(tr$host)} 171 See {ui_code("gh_token_help()")} for help 172 (Or maybe we\'re just offline?)') 173 if (ui_github_remote_config_wat(cfg)) { 174 ui_stop("Aborting") 175 } 176 } 177 178 challenge_non_default_branch( 179 "Are you sure you want to create a PR branch based on a non-default branch?" 180 ) 181 182 online <- is_online(tr$host) 183 if (online) { 184 # this is not pr_pull_source_override() because: 185 # a) we may NOT be on default branch (although we probably are) 186 # b) we didn't just switch to the branch we're on, therefore we have to 187 # consider that the pull may be affected by uncommitted changes or a 188 # merge 189 current_branch <- git_branch() 190 default_branch <- git_branch_default() 191 if (current_branch == default_branch) { 192 # override for mis-configured forks, that have default branch tracking 193 # the fork (origin) instead of the source (upstream) 194 remref <- glue("{tr$remote}/{default_branch}") 195 } else { 196 remref <- git_branch_tracking(current_branch) 197 } 198 if (!is.na(remref)) { 199 comparison <- git_branch_compare(current_branch, remref) 200 if (comparison$remote_only > 0) { 201 challenge_uncommitted_changes(untracked = TRUE) 202 } 203 ui_done("Pulling changes from {ui_value(remref)}") 204 git_pull(remref = remref, verbose = FALSE) 205 } 206 } else { 207 ui_info(" 208 Unable to pull changes for current branch, since we are offline") 209 } 210 211 ui_done("Creating and switching to local branch {ui_value(branch)}") 212 gert::git_branch_create(branch, repo = repo) 213 config_key <- glue("branch.{branch}.created-by") 214 gert::git_config_set(config_key, value = "usethis::pr_init", repo = repo) 215 216 ui_todo("Use {ui_code('pr_push()')} to create PR.") 217 invisible() 218} 219 220#' @export 221#' @rdname pull-requests 222pr_resume <- function(branch = NULL) { 223 if (is.null(branch)) { 224 ui_info(" 225 No branch specified ... looking up local branches and associated PRs") 226 branch <- choose_branch() 227 if (is.null(branch)) { 228 ui_oops("Repo doesn't seem to have any non-default branches") 229 return(invisible()) 230 } 231 if (length(branch) == 0) { 232 ui_oops("No branch selected, exiting") 233 return(invisible()) 234 } 235 } 236 stopifnot(is_string(branch)) 237 238 repo <- git_repo() 239 if (!gert::git_branch_exists(branch, local = TRUE, repo = repo)) { 240 code <- glue("pr_init(\"{branch}\")") 241 ui_stop(" 242 No branch named {ui_value(branch)} exists 243 Call {ui_code(code)} to create a new PR branch") 244 } 245 246 challenge_uncommitted_changes(untracked = TRUE) 247 248 ui_done("Switching to branch {ui_value(branch)}") 249 gert::git_branch_checkout(branch, repo = repo) 250 git_pull() 251 252 ui_todo("Use {ui_code('pr_push()')} to create or update PR.") 253 invisible() 254} 255 256#' @export 257#' @rdname pull-requests 258#' @param number Number of PR. 259#' @param target Which repo to target? This is only a question in the case of a 260#' fork. In a fork, there is some slim chance that you want to consider pull 261#' requests against your fork (the primary repo, i.e. `origin`) instead of 262#' those against the source repo (i.e. `upstream`, which is the default). 263#' 264#' @examples 265#' \dontrun{ 266#' pr_fetch(123) 267#' } 268pr_fetch <- function(number = NULL, target = c("source", "primary")) { 269 tr <- target_repo(github_get = NA, role = target, ask = FALSE) 270 challenge_uncommitted_changes() 271 272 if (is.null(number)) { 273 ui_info("No PR specified ... looking up open PRs") 274 pr <- choose_pr(tr = tr) 275 if (is.null(pr)) { 276 ui_oops("No open PRs found for {ui_value(tr$repo_spec)}") 277 return(invisible()) 278 } 279 if (min(lengths(pr)) == 0) { 280 ui_oops("No PR selected, exiting") 281 return(invisible()) 282 } 283 } else { 284 pr <- pr_get(number = number, tr = tr) 285 } 286 287 if (is.na(pr$pr_repo_owner)) { 288 ui_stop("The repo where PR {number} originates seems to have been deleted") 289 } 290 291 pr_user <- glue("@{pr$pr_user}") 292 ui_done(" 293 Checking out PR {ui_value(pr$pr_string)} ({ui_field(pr_user)}): \\ 294 {ui_value(pr$pr_title)}") 295 296 if (pr$pr_from_fork && isFALSE(pr$maintainer_can_modify)) { 297 ui_info(" 298 Note that user does NOT allow maintainer to modify this PR at this \\ 299 time, although this can be changed.") 300 } 301 302 repo <- git_repo() 303 304 remote <- github_remote_list(pr$pr_remote) 305 if (nrow(remote) == 0) { 306 url <- switch(tr$protocol, https = pr$pr_https_url, ssh = pr$pr_ssh_url) 307 ui_done("Adding remote {ui_value(pr$pr_remote)} as {ui_value(url)}") 308 gert::git_remote_add(url = url, name = pr$pr_remote, repo = repo) 309 config_key <- glue("remote.{pr$pr_remote}.created-by") 310 gert::git_config_set(config_key, "usethis::pr_fetch", repo = repo) 311 } 312 pr_remref <- glue_data(pr, "{pr_remote}/{pr_ref}") 313 gert::git_fetch( 314 remote = pr$pr_remote, 315 refspec = pr$pr_ref, 316 repo = repo, 317 verbose = FALSE 318 ) 319 320 if (is.na(pr$pr_local_branch)) { 321 pr$pr_local_branch <- 322 if (pr$pr_from_fork) sub(":", "-", pr$pr_label) else pr$pr_ref 323 } 324 325 # Create local branch, if necessary, and switch to it ---- 326 if (!gert::git_branch_exists(pr$pr_local_branch, local = TRUE, repo = repo)) { 327 ui_done(" 328 Creating and switching to local branch {ui_value(pr$pr_local_branch)}") 329 ui_done("Setting {ui_value(pr_remref)} as remote tracking branch") 330 gert::git_branch_create(pr$pr_local_branch, ref = pr_remref, repo = repo) 331 config_key <- glue("branch.{pr$pr_local_branch}.created-by") 332 gert::git_config_set(config_key, "usethis::pr_fetch", repo = repo) 333 config_url <- glue("branch.{pr$pr_local_branch}.pr-url") 334 gert::git_config_set(config_url, pr$pr_html_url, repo = repo) 335 return(invisible()) 336 } 337 338 # Local branch pre-existed; make sure tracking branch is set, switch, & pull 339 ui_done("Switching to branch {ui_value(pr$pr_local_branch)}") 340 gert::git_branch_checkout(pr$pr_local_branch, repo = repo) 341 config_url <- glue("branch.{pr$pr_local_branch}.pr-url") 342 gert::git_config_set(config_url, pr$pr_html_url, repo = repo) 343 344 pr_branch_ours_tracking <- git_branch_tracking(pr$pr_local_branch) 345 if (is.na(pr_branch_ours_tracking) || 346 pr_branch_ours_tracking != pr_remref) { 347 ui_done("Setting {ui_value(pr_remref)} as remote tracking branch") 348 gert::git_branch_set_upstream(pr_remref, repo = repo) 349 } 350 git_pull(verbose = FALSE) 351} 352 353#' @export 354#' @rdname pull-requests 355pr_push <- function() { 356 cfg <- github_remote_config(github_get = TRUE) 357 check_ours_or_fork(cfg) 358 check_pr_branch() 359 challenge_uncommitted_changes() 360 361 repo <- git_repo() 362 branch <- git_branch() 363 remref <- git_branch_tracking(branch) 364 if (is.na(remref)) { 365 # this is the first push 366 if (cfg$type == "fork" && cfg$upstream$can_push && is_interactive()) { 367 choices <- c( 368 origin = glue( 369 "{cfg$origin$repo_spec} = {ui_value('origin')} (external PR)"), 370 upstream = glue( 371 "{cfg$upstream$repo_spec} = {ui_value('upstream')} (internal PR)") 372 ) 373 title <- glue("Which repo do you want to push to?") 374 choice <- utils::menu(choices, graphics = FALSE, title = title) 375 remote <- names(choices)[[choice]] 376 } else { 377 remote <- "origin" 378 } 379 ui_done(" 380 Pushing local {ui_value(branch)} branch to {ui_value(remote)} remote") 381 gert::git_push(remote = remote, verbose = FALSE, repo = repo) 382 } else { 383 check_branch_pulled(use = "pr_pull()") 384 ui_done("Pushing local {ui_value(branch)} branch to {ui_value(remref)}") 385 gert::git_push( 386 remote = remref_remote(remref), 387 refspec = glue("refs/heads/{branch}:refs/heads/{remref_branch(remref)}"), 388 verbose = FALSE, 389 repo = repo 390 ) 391 } 392 393 # Prompt to create PR if does not exist yet 394 tr <- target_repo(cfg, ask = FALSE) 395 pr <- pr_find(branch, tr = tr) 396 if (is.null(pr)) { 397 pr_create() 398 } else { 399 ui_todo(" 400 View PR at {ui_value(pr$pr_html_url)} or call {ui_code('pr_view()')}") 401 } 402 403 invisible() 404} 405 406#' @export 407#' @rdname pull-requests 408pr_pull <- function() { 409 check_ours_or_fork() 410 check_pr_branch() 411 challenge_uncommitted_changes() 412 413 git_pull() 414 415 invisible(TRUE) 416} 417 418#' @export 419#' @rdname pull-requests 420pr_merge_main <- function() { 421 tr <- target_repo(github_get = TRUE, ask = FALSE) 422 challenge_uncommitted_changes() 423 remref <- glue("{tr$remote}/{git_branch_default()}") 424 ui_done(" 425 Pulling changes from {ui_value(remref)} (default branch of source repo)") 426 git_pull(remref, verbose = FALSE) 427} 428 429#' @export 430#' @rdname pull-requests 431pr_view <- function(number = NULL, target = c("source", "primary")) { 432 tr <- target_repo(github_get = NA, role = target, ask = FALSE) 433 url <- NULL 434 if (is.null(number)) { 435 branch <- git_branch() 436 default_branch <- git_branch_default() 437 if (branch != default_branch) { 438 url <- pr_url(tr = tr) 439 if (is.null(url)) { 440 ui_info(" 441 Current branch ({ui_value(branch)}) does not appear to be \\ 442 connected to a PR") 443 } else { 444 number <- sub("^.+pull/", "", url) 445 ui_info(" 446 Current branch ({ui_value(branch)}) is connected to PR #{number}") 447 } 448 } 449 } else { 450 pr <- pr_get(number = number, tr = tr) 451 url <- pr$pr_html_url 452 } 453 if (is.null(url)) { 454 ui_info("No PR specified ... looking up open PRs") 455 pr <- choose_pr(tr = tr) 456 if (is.null(pr)) { 457 ui_oops("No open PRs found for {ui_value(tr$repo_spec)}") 458 return(invisible()) 459 } 460 if (min(lengths(pr)) == 0) { 461 ui_oops("No PR selected, exiting") 462 return(invisible()) 463 } 464 url <- pr$pr_html_url 465 } 466 view_url(url) 467} 468 469#' @export 470#' @rdname pull-requests 471pr_pause <- function() { 472 # intentionally naive selection of target repo 473 tr <- target_repo(github_get = FALSE, ask = FALSE) 474 475 default_branch <- git_branch_default() 476 if (git_branch() == default_branch) { 477 ui_info(" 478 Already on this repo's default branch ({ui_value(default_branch)}) 479 Nothing to do") 480 return(invisible()) 481 } 482 challenge_uncommitted_changes() 483 # TODO: what happens here if offline? 484 check_branch_pulled(use = "pr_pull()") 485 486 ui_done("Switching back to default branch ({ui_value(default_branch)})") 487 gert::git_branch_checkout(default_branch, repo = git_repo()) 488 pr_pull_source_override(tr = tr) 489} 490 491#' @export 492#' @rdname pull-requests 493pr_finish <- function(number = NULL, target = c("source", "primary")) { 494 pr_clean(number = number, target = target, mode = "finish") 495} 496 497#' @export 498#' @rdname pull-requests 499pr_forget <- function() pr_clean(mode = "forget") 500 501# unexported helpers ---- 502 503# Removes local evidence of PRs that you're done with or wish you'd never 504# started or fetched 505# Only possible remote action is to delete the remote branch for a merged PR 506pr_clean <- function(number = NULL, 507 target = c("source", "primary"), 508 mode = c("finish", "forget")) { 509 mode <- match.arg(mode) 510 repo <- git_repo() 511 tr <- target_repo(github_get = NA, role = target, ask = FALSE) 512 513 if (is.null(number)) { 514 check_pr_branch() 515 pr <- pr_find(git_branch(), tr = tr, state = "all") 516 } else { 517 pr <- pr_get(number = number, tr = tr) 518 } 519 520 pr_local_branch <- if (is.null(pr)) git_branch() else pr$pr_local_branch 521 522 if (!is.na(pr_local_branch)) { 523 if (pr_local_branch == git_branch()) { 524 challenge_uncommitted_changes() 525 } 526 tracking_branch <- git_branch_tracking(pr_local_branch) 527 if (is.na(tracking_branch)) { 528 if (ui_nope(" 529 Local branch {ui_value(pr_local_branch)} has no associated remote \\ 530 branch. 531 If we delete {ui_value(pr_local_branch)}, any work that exists only \\ 532 on this branch work may be hard for you to recover. 533 Proceed anyway?")) { 534 ui_stop("Aborting.") 535 } 536 } else { 537 cmp <- git_branch_compare( 538 branch = pr_local_branch, 539 remref = tracking_branch 540 ) 541 if (cmp$local_only > 0 && ui_nope(" 542 Local branch {ui_value(pr_local_branch)} has 1 or more commits \\ 543 that have not been pushed to {ui_value(tracking_branch)}. 544 If we delete {ui_value(pr_local_branch)}, this work may be hard \\ 545 for you to recover. 546 Proceed anyway?")) { 547 ui_stop("Aborting.") 548 } 549 } 550 } 551 552 default_branch <- git_branch_default() 553 if (git_branch() != default_branch) { 554 ui_done("Switching back to default branch ({ui_value(default_branch)})") 555 gert::git_branch_checkout(default_branch, force = TRUE, repo = repo) 556 pr_pull_source_override(tr = tr) 557 } 558 559 if (!is.na(pr_local_branch)) { 560 ui_done("Deleting local {ui_value(pr_local_branch)} branch") 561 gert::git_branch_delete(pr_local_branch, repo = repo) 562 } 563 564 if (is.null(pr)) { 565 return(invisible()) 566 } 567 568 pr_branch_delete(pr) 569 570 # delete remote, if we added it AND no remaining tracking branches 571 created_by <- git_cfg_get(glue("remote.{pr$pr_remote}.created-by")) 572 if (is.null(created_by) || !grepl("^usethis::pr_", created_by)) { 573 return(invisible()) 574 } 575 576 branches <- gert::git_branch_list(local = TRUE, repo = repo) 577 branches <- branches[!is.na(branches$upstream), ] 578 if (sum(grepl(glue("^refs/remotes/{pr$pr_remote}"), branches$upstream)) == 0) { 579 ui_done("Removing remote {ui_value(pr$pr_remote)}") 580 gert::git_remote_remove(remote = pr$pr_remote, repo = repo) 581 } 582 invisible() 583} 584 585# Make sure to pull from upstream/DEFAULT (as opposed to origin/DEFAULT) if 586# we're in DEFAULT branch of a fork. I wish everyone set up DEFAULT to track the 587# DEFAULT branch in the source repo, but this protects us against sub-optimal 588# setup. 589pr_pull_source_override <- function(tr = NULL) { 590 # naive selection of target repo; calling function should analyse the config 591 tr <- tr %||% target_repo(github_get = FALSE, ask = FALSE) 592 current_branch <- git_branch() 593 default_branch <- git_branch_default() 594 if (current_branch != default_branch) { 595 ui_stop(" 596 Internal error: pr_pull_source_override() should only be used when on \\ 597 default branch") 598 } 599 # override for mis-configured forks, that have default branch tracking 600 # the fork (origin) instead of the source (upstream) 601 remref <- glue("{tr$remote}/{default_branch}") 602 if (is_online(tr$host)) { 603 ui_done("Pulling changes from {ui_value(remref)}") 604 git_pull(remref = remref, verbose = FALSE) 605 } else { 606 ui_info(" 607 Can't reach {ui_value(tr$host)}, therefore unable to pull changes from \\ 608 {ui_value(remref)}") 609 } 610} 611 612pr_create <- function() { 613 branch <- git_branch() 614 tracking_branch <- git_branch_tracking(branch) 615 remote <- remref_remote(tracking_branch) 616 remote_dat <- github_remotes(remote, github_get = FALSE) 617 ui_todo("Create PR at link given below") 618 view_url(glue_data(remote_dat, "{host_url}/{repo_spec}/compare/{branch}")) 619} 620 621# retrieves 1 PR, if we can establish a tracking relationship between 622# `branch` and a PR branch 623pr_find <- function(branch = git_branch(), 624 tr = NULL, 625 state = c("open", "closed", "all")) { 626 # Have we done this before? Check if we've cached pr-url in git config. 627 config_url <- glue("branch.{branch}.pr-url") 628 url <- git_cfg_get(config_url, where = "local") 629 if (!is.null(url)) { 630 return(pr_get(number = sub("^.+pull/", "", url), tr = tr)) 631 } 632 633 tracking_branch <- git_branch_tracking(branch) 634 if (is.na(tracking_branch)) { 635 return(NULL) 636 } 637 638 state <- match.arg(state) 639 remote <- remref_remote(tracking_branch) 640 remote_dat <- github_remotes(remote) 641 pr_dat <- pr_list( 642 tr = tr, 643 state = state, 644 head = glue("{remote_dat$repo_owner}:{remref_branch(tracking_branch)}") 645 ) 646 if (nrow(pr_dat) == 0) { 647 return(NULL) 648 } 649 if (nrow(pr_dat) > 1) { 650 ui_stop(" 651 Branch {ui_value(branch)} is associated with multiple PRs: \\ 652 {ui_value(paste0('#', pr_dat$pr_number))}") 653 } 654 gert::git_config_set(config_url, pr_dat$pr_html_url, repo = git_repo()) 655 as.list(pr_dat) 656} 657 658pr_url <- function(branch = git_branch(), 659 tr = NULL, 660 state = c("open", "closed", "all")) { 661 state <- match.arg(state) 662 pr <- pr_find(branch, tr = tr, state = state) 663 if (is.null(pr)) { 664 NULL 665 } else { 666 pr$pr_html_url 667 } 668} 669 670pr_data_tidy <- function(pr) { 671 out <- list( 672 pr_number = pluck_int(pr, "number"), 673 pr_title = pluck_chr(pr, "title"), 674 pr_user = pluck_chr(pr, "user", "login"), 675 pr_created_at = pluck_chr(pr, "created_at"), 676 pr_updated_at = pluck_chr(pr, "updated_at"), 677 pr_merged_at = pluck_chr(pr, "merged_at"), 678 pr_label = pluck_chr(pr, "head", "label"), 679 # the 'repo' element of 'head' is NULL when fork has been deleted 680 pr_repo_owner = pluck_chr(pr, "head", "repo", "owner", "login"), 681 pr_ref = pluck_chr(pr, "head", "ref"), 682 pr_repo_spec = pluck_chr(pr, "head", "repo", "full_name"), 683 pr_from_fork = pluck_lgl(pr, "head", "repo", "fork"), 684 # 'maintainer_can_modify' is only present when we GET one specific PR 685 pr_maintainer_can_modify = pluck_lgl(pr, "maintainer_can_modify"), 686 pr_https_url = pluck_chr(pr, "head", "repo", "clone_url"), 687 pr_ssh_url = pluck_chr(pr, "head", "repo", "ssh_url"), 688 pr_html_url = pluck_chr(pr, "html_url"), 689 pr_string = glue(" 690 {pluck_chr(pr, 'base', 'repo', 'full_name')}/#{pluck_int(pr, 'number')}") 691 ) 692 693 grl <- github_remote_list(these = NULL) 694 m <- match(out$pr_repo_spec, grl$repo_spec) 695 out$pr_remote <- if (is.na(m)) out$pr_repo_owner else grl$remote[m] 696 697 pr_remref <- glue("{out$pr_remote}/{out$pr_ref}") 698 gbl <- gert::git_branch_list(local = TRUE, repo = git_repo()) 699 gbl <- gbl[!is.na(gbl$upstream), c("name", "upstream")] 700 gbl$upstream <- sub("^refs/remotes/", "", gbl$upstream) 701 m <- match(pr_remref, gbl$upstream) 702 out$pr_local_branch <- if (is.na(m)) NA else gbl$name[m] 703 704 # If the fork has been deleted, these are all NA 705 # - Because pr$head$repo is NULL: 706 # pr_repo_owner, pr_repo_spec, pr_from_fork, pr_https_url, pr_ssh_url 707 # - Because derived from those above: 708 # pr_remote, pr_remref pr_local_branch 709 # I suppose one could already have a local branch, if you fetched the PR 710 # beforethe fork got deleted. 711 # But an initial pr_fetch() won't work if the fork has been deleted. 712 # I'm willing to accept that the pr_*() functions don't necessarily address 713 # the "deleted fork" scenario. It's relatively rare. 714 # example: https://github.com/r-lib/httr/pull/634 715 716 out 717} 718 719pr_list <- function(tr = NULL, 720 github_get = NA, 721 state = c("open", "closed", "all"), 722 head = NULL) { 723 tr <- tr %||% target_repo(github_get = github_get, ask = FALSE) 724 state <- match.arg(state) 725 gh <- gh_tr(tr) 726 safely_gh <- purrr::safely(gh, otherwise = NULL) 727 out <- safely_gh( 728 "GET /repos/{owner}/{repo}/pulls", 729 state = state, head = head, .limit = Inf 730 ) 731 if (!is.null(out$error)) { 732 ui_oops("Unable to retrieve PRs for {ui_value(tr$repo_spec)}") 733 prs <- NULL 734 } else { 735 prs <- out$result 736 } 737 no_prs <- length(prs) == 0 738 if (no_prs) { 739 prs <- list(list()) 740 } 741 out <- map(prs, pr_data_tidy) 742 out <- map(out, ~ as.data.frame(.x, stringsAsFactors = FALSE)) 743 out <- do.call(rbind, out) 744 if (no_prs) { 745 out[0, ] 746 } else { 747 out 748 } 749} 750 751# retrieves specific PR by number 752pr_get <- function(number, tr = NULL, github_get = NA) { 753 tr <- tr %||% target_repo(github_get = github_get, ask = FALSE) 754 gh <- gh_tr(tr) 755 raw <- gh("GET /repos/{owner}/{repo}/pulls/{number}", number = number) 756 pr_data_tidy(raw) 757} 758 759check_pr_branch <- function() { 760 default_branch <- git_branch_default() 761 if (git_branch() != default_branch) { 762 return(invisible()) 763 } 764 ui_stop(" 765 The {ui_code('pr_*()')} functions facilitate pull requests. 766 The current branch ({ui_value(default_branch)}) is this repo's default \\ 767 branch, but pull requests should NOT come from the default branch. 768 Do you need to call {ui_code('pr_init()')} (new PR)? 769 Or {ui_code('pr_resume()')} or {ui_code('pr_fetch()')} (existing PR)?") 770} 771 772branches_with_no_upstream_or_github_upstream <- function(tr = NULL) { 773 repo <- git_repo() 774 gb_dat <- gert::git_branch_list(local = TRUE, repo = repo) 775 gb_dat <- gb_dat[ 776 gb_dat$name != git_branch_default(), 777 c("name", "upstream", "updated") 778 ] 779 gb_dat$remref <- sub("^refs/remotes/", "", gb_dat$upstream) 780 gb_dat$upstream <- NULL 781 gb_dat$remote <- remref_remote(gb_dat$remref) 782 gb_dat$ref <- remref_branch(gb_dat$remref) 783 784 ghr <- github_remote_list(these = NULL)[["remote"]] 785 gb_dat <- gb_dat[is.na(gb_dat$remref) | (gb_dat$remote %in% ghr), ] 786 787 pr_dat <- pr_list(tr = tr) 788 dat <- merge( 789 x = gb_dat, y = pr_dat, 790 by.x = "name", by.y = "pr_local_branch", 791 all.x = TRUE 792 ) 793 dat <- dat[order(dat$pr_number, dat$pr_updated_at, dat$updated, decreasing = TRUE), ] 794 795 dat 796} 797 798choose_branch <- function() { 799 if (!is_interactive()) { 800 return(character()) 801 } 802 dat <- branches_with_no_upstream_or_github_upstream() 803 if (nrow(dat) == 0) { 804 return() 805 } 806 prompt <- "Which branch do you want to checkout? (0 to exit)" 807 if (nrow(dat) > 9) { 808 branches_not_shown <- utils::tail(dat$name, -9) 809 n <- length(branches_not_shown) 810 dat <- dat[1:9, ] 811 pre <- glue("{n} branch{if (n > 1) 'es' else ''} not listed: ") 812 listing <- glue_collapse( 813 branches_not_shown, sep = ", ", width = getOption("width") - nchar(pre) 814 ) 815 prompt <- glue(" 816 {prompt} 817 {pre}{listing}") 818 } 819 dat$pretty_user <- map(dat$pr_user, ~ glue("@{.x}")) 820 dat$pretty_name <- format(dat$name, justify = "right") 821 dat_pretty <- purrr::pmap( 822 dat[c("pretty_name", "pr_number", "pretty_user", "pr_title")], 823 function(pretty_name, pr_number, pretty_user, pr_title) { 824 if (is.na(pr_number)) { 825 glue("{pretty_name}") 826 } else { 827 glue("{pretty_name} --> #{pr_number} ({ui_value(pretty_user)}): {pr_title}") 828 } 829 } 830 ) 831 choice <- utils::menu(title = prompt, choices = dat_pretty) 832 dat$name[choice] 833} 834 835choose_pr <- function(tr = NULL) { 836 if (!is_interactive()) { 837 return(list(pr_number = list())) 838 } 839 tr <- tr %||% target_repo() 840 dat <- pr_list(tr) 841 if (nrow(dat) == 0) { 842 return() 843 } 844 # wording needs to make sense for pr_fetch() and pr_view() 845 prompt <- "Which PR are you interested in? (0 to exit)" 846 if (nrow(dat) > 9) { 847 n <- nrow(dat) - 9 848 dat <- dat[1:9, ] 849 prompt <- glue(" 850 {prompt} 851 {n} more {if (n > 1) 'PRs are' else 'PR is'} open; \\ 852 call {ui_code('browse_github_pulls()')} to browse all PRs") 853 } 854 pr_pretty <- purrr::pmap( 855 dat[c("pr_string", "pr_user", "pr_title")], 856 function(pr_string, pr_user, pr_title) { 857 at_user <- glue("@{pr_user}") 858 glue(" 859 {ui_value(pr_string)} ({ui_field(at_user)}): {ui_value(pr_title)}") 860 } 861 ) 862 choice <- utils::menu(title = prompt, choices = pr_pretty) 863 as.list(dat[choice, ]) 864} 865 866# deletes the remote branch associated with a PR 867# returns invisible TRUE/FALSE re: whether a deletion actually occurred 868# reasons this returns FALSE 869# * don't have push permission on remote where PR branch lives 870# * PR has not been merged 871# * remote branch has already been deleted 872pr_branch_delete <- function(pr) { 873 remote <- pr$pr_remote 874 remote_dat <- github_remotes(remote) 875 if (!isTRUE(remote_dat$can_push)) { 876 return(invisible(FALSE)) 877 } 878 879 gh <- gh_tr(remote_dat) 880 pr_ref <- tryCatch( 881 gh( 882 "GET /repos/{owner}/{repo}/git/ref/{ref}", 883 ref = glue("heads/{pr$pr_ref}") 884 ), 885 http_error_404 = function(cnd) NULL 886 ) 887 888 pr_remref <- glue_data(pr, "{pr_remote}/{pr_ref}") 889 890 if (is.null(pr_ref)) { 891 ui_info(" 892 PR {ui_value(pr$pr_string)} originated from branch \\ 893 {ui_value(pr_remref)}, which no longer exists") 894 return(invisible(FALSE)) 895 } 896 897 if (is.na(pr$pr_merged_at)) { 898 ui_info(" 899 PR {ui_value(pr$pr_string)} is unmerged, \\ 900 we will not delete the remote branch {ui_value(pr_remref)}") 901 return(invisible(FALSE)) 902 } 903 904 ui_done(" 905 PR {ui_value(pr$pr_string)} has been merged, \\ 906 deleting remote branch {ui_value(pr_remref)}") 907 # TODO: tryCatch here? 908 gh( 909 "DELETE /repos/{owner}/{repo}/git/refs/{ref}", 910 ref = glue("heads/{pr$pr_ref}") 911 ) 912 invisible(TRUE) 913} 914