Nothing
#' Helpers for GitHub pull requests
#'
#' @description
#' The `pr_*` family of functions is designed to make working with GitHub pull
#' requests (PRs) as painless as possible for both contributors and package
#' maintainers.
#'
#' To use the `pr_*` functions, your project must be a Git repo and have one of
#' these GitHub remote configurations:
#' * "ours": You can push to the GitHub remote configured as `origin` and it's
#' not a fork.
#' * "fork": You can push to the GitHub remote configured as `origin`, it's a
#' fork, and its parent is configured as `upstream`. `origin` points to your
#' **personal** copy and `upstream` points to the **source repo**.
#'
#' "Ours" and "fork" are two of several GitHub remote configurations examined in
#' [Common remote setups](https://happygitwithr.com/common-remote-setups.html)
#' in Happy Git and GitHub for the useR.
#'
#' The [Pull Request
#' Helpers](https://usethis.r-lib.org/articles/articles/pr-functions.html)
#' article walks through the process of making a pull request with the `pr_*`
#' functions.
#'
#' The `pr_*` functions also use your Git/GitHub credentials to carry out
#' various remote operations; see below for more about auth. The `pr_*`
#' functions also proactively check for agreement re: the default branch in your
#' local repo and the source repo. See [git_default_branch()] for more.
#'
#' @template double-auth
#'
#' @section For contributors:
#' To contribute to a package, first use `create_from_github("OWNER/REPO")`.
#' This forks the source repository and checks out a local copy.
#'
#' Next use `pr_init()` to create a branch for your PR. It is best practice to
#' never make commits to the default branch branch of a fork (usually named
#' `main` or `master`), because you do not own it. A pull request should always
#' come from a feature branch. It will be much easier to pull upstream changes
#' from the fork parent if you only allow yourself to work in feature branches.
#' It is also much easier for a maintainer to explore and extend your PR if you
#' create a feature branch.
#'
#' Work locally, in your branch, making changes to files, and committing your
#' work. Once you're ready to create the PR, run `pr_push()` to push your local
#' branch to GitHub, and open a webpage that lets you initiate the PR (or draft
#' PR).
#'
#' To learn more about the process of making a pull request, read the [Pull
#' Request
#' Helpers](https://usethis.r-lib.org/articles/articles/pr-functions.html)
#' vignette.
#'
#' If you are lucky, your PR will be perfect, and the maintainer will accept it.
#' You can then run `pr_finish()` to delete your PR branch. In most cases,
#' however, the maintainer will ask you to make some changes. Make the changes,
#' then run `pr_push()` to update your PR.
#'
#' It's also possible that the maintainer will contribute some code to your PR:
#' to get those changes back onto your computer, run `pr_pull()`. It can also
#' happen that other changes have occurred in the package since you first
#' created your PR. You might need to merge the default branch (usually named
#' `main` or `master`) into your PR branch. Do that by running
#' `pr_merge_main()`: this makes sure that your PR is compatible with the
#' primary repo's main line of development. Both `pr_pull()` and
#' `pr_merge_main()` can result in merge conflicts, so be prepared to resolve
#' before continuing.
#'
#' @section For maintainers:
#' To download a PR locally so that you can experiment with it, run
#' `pr_fetch()` and select the PR or, if you already know its number, call
#' `pr_fetch(<pr_number>)`. If you make changes, run `pr_push()` to push them
#' back to GitHub. After you have merged the PR, run `pr_finish()` to delete the
#' local branch and remove the remote associated with the contributor's fork.
#'
#' @section Overview of all the functions:
#' * `pr_init()`: As a contributor, start work on a new PR by ensuring that
#' your local repo is up-to-date, then creating and checking out a new branch.
#' Nothing is pushed to or created on GitHub until you call `pr_push()`.
#' * `pr_fetch()`: As a maintainer, review or contribute changes to an existing
#' PR by creating a local branch that tracks the remote PR. `pr_fetch()` does as
#' little work as possible, so you can also use it to resume work on an PR that
#' already has a local branch (where it will also ensure your local branch is
#' up-to-date). If called with no arguments, up to 9 open PRs are offered for
#' interactive selection.
#' * `pr_resume()`: Resume work on a PR by switching to an existing local branch
#' and pulling any changes from its upstream tracking branch, if it has one. If
#' called with no arguments, up to 9 local branches are offered for interactive
#' selection, with a preference for branches connected to PRs and for branches
#' with recent activity.
#' * `pr_push()`: The first time it's called, a PR branch is pushed to GitHub
#' and you're taken to a webpage where a new PR (or draft PR) can be created.
#' This also sets up the local branch to track its remote counterpart.
#' Subsequent calls to `pr_push()` make sure the local branch has all the remote
#' changes and, if so, pushes local changes, thereby updating the PR.
#' * `pr_pull()`: Pulls changes from the local branch's remote tracking branch.
#' If a maintainer has extended your PR, this is how you bring those changes
#' back into your local work.
#' * `pr_merge_main()`: Pulls changes from the default branch of the source repo
#' into the current local branch. This can be used when the local branch is the
#' default branch or when it's a PR branch.
#' * `pr_pause()`: Makes sure you're up-to-date with any remote changes in the
#' PR. Then switches back to the default branch and pulls from the source repo.
#' Use `pr_resume()` with name of branch or use `pr_fetch()` to resume using PR
#' number.
#' * `pr_view()`: Visits the PR associated with the current branch in the
#' browser (default) or the specific PR identified by `number`.
#' (FYI [browse_github_pulls()] is a handy way to visit the list of all PRs for
#' the current project.)
#' * `pr_forget()`: Does local clean up when the current branch is an actual or
#' notional PR that you want to abandon. Maybe you initiated it yourself, via
#' `pr_init()`, or you used `pr_fetch()` to explore a PR from GitHub. Only does
#' *local* operations: does not update or delete any remote branches, nor does
#' it close any PRs. Alerts the user to any uncommitted or unpushed work that is
#' at risk of being lost. If user chooses to proceed, switches back to the
#' default branch, pulls changes from source repo, and deletes local PR branch.
#' Any associated Git remote is deleted, if the "forgotten" PR was the only
#' branch using it.
#' * `pr_finish()`: Does post-PR clean up, but does NOT actually merge or close
#' a PR (maintainer should do this in the browser). If `number` is not given,
#' infers the PR from the upstream tracking branch of the current branch. If
#' `number` is given, it does not matter whether the PR exists locally. If PR
#' exists locally, alerts the user to uncommitted or unpushed changes, then
#' switches back to the default branch, pulls changes from source repo, and
#' deletes local PR branch. If the PR came from an external fork, any associated
#' Git remote is deleted, provided it's not in use by any other local branches.
#' If the PR has been merged and user has permission, deletes the remote branch
#' (this is the only remote operation that `pr_finish()` potentially does).
#'
#' @name pull-requests
NULL
#' @export
#' @rdname pull-requests
#' @param branch Name of a new or existing local branch. If creating a new
#' branch, note this should usually consist of lower case letters, numbers,
#' and `-`.
pr_init <- function(branch) {
check_string(branch)
repo <- git_repo()
if (gert::git_branch_exists(branch, local = TRUE, repo = repo)) {
code <- glue('pr_resume("{branch}")')
ui_bullets(c(
"i" = "Branch {.val {branch}} already exists, calling {.code {code}}."
))
return(pr_resume(branch))
}
# don't absolutely require PAT success, because we could be offline
# or in another salvageable situation, e.g. need to configure PAT
cfg <- github_remote_config(github_get = NA)
check_for_bad_config(cfg)
tr <- target_repo(cfg, ask = FALSE)
maybe_good_configs <- c("maybe_ours_or_theirs", "maybe_fork")
if (cfg$type %in% maybe_good_configs) {
ui_bullets(c(
"x" = 'Unable to confirm the GitHub remote configuration is
"pull request ready".',
"i" = "You probably need to configure a personal access token for
{.val {tr$host}}.",
"i" = "See {.run usethis::gh_token_help()} for help with that.",
"i" = "(Or maybe we're just offline?)"
))
if (ui_github_remote_config_wat(cfg)) {
ui_bullets(c("x" = "Cancelling."))
return(invisible())
}
}
default_branch <- git_default_branch()
challenge_non_default_branch(
"Are you sure you want to create a PR branch based on a non-default branch?",
default_branch = default_branch
)
online <- is_online(tr$host)
if (online) {
# this is not pr_pull_source_override() because:
# a) we may NOT be on default branch (although we probably are)
# b) we didn't just switch to the branch we're on, therefore we have to
# consider that the pull may be affected by uncommitted changes or a
# merge
current_branch <- git_branch()
if (current_branch == default_branch) {
# override for mis-configured forks, that have default branch tracking
# the fork (origin) instead of the source (upstream)
remref <- glue("{tr$remote}/{default_branch}")
} else {
remref <- git_branch_tracking(current_branch)
}
if (!is.na(remref)) {
comparison <- git_branch_compare(current_branch, remref)
if (comparison$remote_only > 0) {
challenge_uncommitted_changes()
}
ui_bullets(c("v" = "Pulling changes from {.val {remref}}."))
git_pull(remref = remref, verbose = FALSE)
}
} else {
ui_bullets(c(
"!" = "Unable to pull changes for current branch, since we are offline."
))
}
ui_bullets(c("v" = "Creating and switching to local branch {.val {branch}}."))
gert::git_branch_create(branch, repo = repo)
config_key <- glue("branch.{branch}.created-by")
gert::git_config_set(config_key, value = "usethis::pr_init", repo = repo)
ui_bullets(c("_" = "Use {.run usethis::pr_push()} to create a PR."))
invisible()
}
#' @export
#' @rdname pull-requests
pr_resume <- function(branch = NULL) {
repo <- git_repo()
if (is.null(branch)) {
ui_bullets(c(
"i" = "No branch specified ... looking up local branches and associated PRs."
))
default_branch <- git_default_branch()
branch <- choose_branch(exclude = default_branch)
if (is.null(branch)) {
ui_bullets(c("x" = "Repo doesn't seem to have any non-default branches."))
return(invisible())
}
if (length(branch) == 0) {
ui_bullets(c("x" = "No branch selected, exiting."))
return(invisible())
}
}
check_string(branch)
if (!gert::git_branch_exists(branch, local = TRUE, repo = repo)) {
code <- glue('usethis::pr_init("{branch}")')
ui_abort(c(
"x" = "No branch named {.val {branch}} exists.",
"_" = "Call {.run {code}} to create a new PR branch."
))
}
challenge_uncommitted_changes()
ui_bullets(c("v" = "Switching to branch {.val {branch}}."))
gert::git_branch_checkout(branch, repo = repo)
git_pull()
ui_bullets(c("_" = "Use {.run usethis::pr_push()} to create or update PR."))
invisible()
}
#' @export
#' @rdname pull-requests
#' @param number Number of PR.
#' @param target Which repo to target? This is only a question in the case of a
#' fork. In a fork, there is some slim chance that you want to consider pull
#' requests against your fork (the primary repo, i.e. `origin`) instead of
#' those against the source repo (i.e. `upstream`, which is the default).
#'
#' @examples
#' \dontrun{
#' pr_fetch(123)
#' }
pr_fetch <- function(number = NULL, target = c("source", "primary")) {
repo <- git_repo()
tr <- target_repo(github_get = NA, role = target, ask = FALSE)
challenge_uncommitted_changes()
if (is.null(number)) {
ui_bullets(c("i" = "No PR specified ... looking up open PRs."))
pr <- choose_pr(tr = tr)
if (is.null(pr)) {
ui_bullets(c("x" = "No open PRs found for {.val {tr$repo_spec}}."))
return(invisible())
}
if (min(lengths(pr)) == 0) {
ui_bullets(c("x" = "No PR selected, exiting."))
return(invisible())
}
} else {
pr <- pr_get(number = number, tr = tr)
}
if (is.na(pr$pr_repo_owner)) {
ui_abort("
The repo or branch where {.href [PR #{pr$pr_number}]({pr$pr_html_url})} originates seems to have been
deleted.")
}
pr_user <- glue("@{pr$pr_user}")
ui_bullets(c(
"v" = "Checking out PR {.val {pr$pr_string}} ({.field {pr_user}}):
{.val {pr$pr_title}}."
))
if (pr$pr_from_fork && isFALSE(pr$maintainer_can_modify)) {
ui_bullets(c(
"!" = "Note that user does NOT allow maintainer to modify this PR at this
time, although this can be changed."
))
}
remote <- github_remote_list(pr$pr_remote)
if (nrow(remote) == 0) {
url <- switch(tr$protocol, https = pr$pr_https_url, ssh = pr$pr_ssh_url)
ui_bullets(c("v" = "Adding remote {.val {pr$pr_remote}} as {.val {url}}."))
gert::git_remote_add(url = url, name = pr$pr_remote, repo = repo)
config_key <- glue("remote.{pr$pr_remote}.created-by")
gert::git_config_set(config_key, "usethis::pr_fetch", repo = repo)
}
pr_remref <- glue_data(pr, "{pr_remote}/{pr_ref}")
gert::git_fetch(
remote = pr$pr_remote,
refspec = pr$pr_ref,
repo = repo,
verbose = FALSE
)
if (is.na(pr$pr_local_branch)) {
pr$pr_local_branch <-
if (pr$pr_from_fork) sub(":", "-", pr$pr_label) else pr$pr_ref
}
# Create local branch, if necessary, and switch to it ----
if (!gert::git_branch_exists(pr$pr_local_branch, local = TRUE, repo = repo)) {
ui_bullets(c(
"v" = "Creating and switching to local branch {.val {pr$pr_local_branch}}.",
"v" = "Setting {.val {pr_remref}} as remote tracking branch."
))
gert::git_branch_create(pr$pr_local_branch, ref = pr_remref, repo = repo)
config_key <- glue("branch.{pr$pr_local_branch}.created-by")
gert::git_config_set(config_key, "usethis::pr_fetch", repo = repo)
config_url <- glue("branch.{pr$pr_local_branch}.pr-url")
gert::git_config_set(config_url, pr$pr_html_url, repo = repo)
return(invisible())
}
# Local branch pre-existed; make sure tracking branch is set, switch, & pull
ui_bullets(c("v" = "Switching to branch {.val {pr$pr_local_branch}}."))
gert::git_branch_checkout(pr$pr_local_branch, repo = repo)
config_url <- glue("branch.{pr$pr_local_branch}.pr-url")
gert::git_config_set(config_url, pr$pr_html_url, repo = repo)
pr_branch_ours_tracking <- git_branch_tracking(pr$pr_local_branch)
if (is.na(pr_branch_ours_tracking) ||
pr_branch_ours_tracking != pr_remref) {
ui_bullets(c("v" = "Setting {.val {pr_remref}} as remote tracking branch."))
gert::git_branch_set_upstream(pr_remref, repo = repo)
}
git_pull(verbose = FALSE)
}
#' @export
#' @rdname pull-requests
pr_push <- function() {
repo <- git_repo()
cfg <- github_remote_config(github_get = TRUE)
check_for_config(cfg, ok_configs = c("ours", "fork"))
default_branch <- git_default_branch()
check_pr_branch(default_branch)
challenge_uncommitted_changes()
branch <- git_branch()
remref <- git_branch_tracking(branch)
if (is.na(remref)) {
# this is the first push
if (cfg$type == "fork" && cfg$upstream$can_push && is_interactive()) {
choices <- c(
origin = ui_pre_glue("
<<cfg$origin$repo_spec>> = {.val origin} (external PR)"),
upstream = ui_pre_glue("
<<cfg$upstream$repo_spec>> = {.val upstream} (internal PR)")
)
choices_formatted <- map_chr(choices, cli::format_inline)
title <- glue("Which repo do you want to push to?")
choice <- utils::menu(choices_formatted, graphics = FALSE, title = title)
remote <- names(choices)[[choice]]
} else {
remote <- "origin"
}
git_push_first(branch, remote)
} else {
check_branch_pulled(use = "pr_pull()")
git_push(branch, remref)
}
# Prompt to create PR if does not exist yet
tr <- target_repo(cfg, ask = FALSE)
pr <- pr_find(branch, tr = tr)
if (is.null(pr)) {
pr_create()
} else {
ui_bullets(c(
"_" = "View PR at {.url {pr$pr_html_url}} or call {.run usethis::pr_view()}."
))
}
invisible()
}
#' @export
#' @rdname pull-requests
pr_pull <- function() {
cfg <- github_remote_config(github_get = TRUE)
check_for_config(cfg)
default_branch <- git_default_branch()
check_pr_branch(default_branch)
challenge_uncommitted_changes()
git_pull()
# note associated PR in git config, if applicable
tr <- target_repo(cfg, ask = FALSE)
pr_find(tr = tr)
invisible(TRUE)
}
#' @export
#' @rdname pull-requests
pr_merge_main <- function() {
tr <- target_repo(github_get = TRUE, ask = FALSE)
challenge_uncommitted_changes()
remref <- glue("{tr$remote}/{tr$default_branch}")
ui_bullets(c("v" = "Pulling changes from {.val {remref}}."))
git_pull(remref, verbose = FALSE)
}
#' @export
#' @rdname pull-requests
pr_view <- function(number = NULL, target = c("source", "primary")) {
tr <- target_repo(github_get = NA, role = target, ask = FALSE)
url <- NULL
if (is.null(number)) {
branch <- git_branch()
default_branch <- git_default_branch()
if (branch != default_branch) {
url <- pr_url(branch = branch, tr = tr)
if (is.null(url)) {
ui_bullets(c(
"i" = "Current branch ({.val {branch}}) does not appear to be
connected to a PR."
))
} else {
number <- sub("^.+pull/", "", url)
ui_bullets(c(
"i" = "Current branch ({.val {branch}}) is connected to PR #{number}."
))
}
}
} else {
pr <- pr_get(number = number, tr = tr)
url <- pr$pr_html_url
}
if (is.null(url)) {
ui_bullets(c("i" = "No PR specified ... looking up open PRs."))
pr <- choose_pr(tr = tr)
if (is.null(pr)) {
ui_bullets(c("x" = "No open PRs found for {.val {tr$repo_spec}}."))
return(invisible())
}
if (min(lengths(pr)) == 0) {
ui_bullets(c("x" = "No PR selected, exiting."))
return(invisible())
}
url <- pr$pr_html_url
}
view_url(url)
}
#' @export
#' @rdname pull-requests
pr_pause <- function() {
# intentionally naive selection of target repo
tr <- target_repo(github_get = FALSE, ask = FALSE)
ui_bullets(c("v" = "Switching back to the default branch."))
default_branch <- git_default_branch()
if (git_branch() == default_branch) {
ui_bullets(c(
"!" = "Already on this repo's default branch ({.val {default_branch}}),
nothing to do."
))
return(invisible())
}
challenge_uncommitted_changes()
# TODO: what happens here if offline?
check_branch_pulled(use = "pr_pull()")
ui_bullets(c(
"v" = "Switching back to default branch ({.val {default_branch}})."
))
gert::git_branch_checkout(default_branch, repo = git_repo())
pr_pull_source_override(tr = tr, default_branch = default_branch)
}
#' @export
#' @rdname pull-requests
pr_finish <- function(number = NULL, target = c("source", "primary")) {
pr_clean(number = number, target = target, mode = "finish")
}
#' @export
#' @rdname pull-requests
pr_forget <- function() pr_clean(mode = "forget")
# unexported helpers ----
# Removes local evidence of PRs that you're done with or wish you'd never
# started or fetched
# Only possible remote action is to delete the remote branch for a merged PR
pr_clean <- function(number = NULL,
target = c("source", "primary"),
mode = c("finish", "forget")) {
withr::defer(rstudio_git_tickle())
mode <- match.arg(mode)
repo <- git_repo()
tr <- target_repo(github_get = NA, role = target, ask = FALSE)
default_branch <- git_default_branch()
if (is.null(number)) {
check_pr_branch(default_branch)
pr <- pr_find(git_branch(), tr = tr, state = "all")
# if the remote branch has already been deleted (probably post-merge), we
# can't always reverse engineer what the corresponding local branch was, but
# we already know it -- it's how we found the PR in the first place!
if (!is.null(pr)) {
pr$pr_local_branch <- pr$pr_local_branch %|% git_branch()
}
} else {
pr <- pr_get(number = number, tr = tr)
}
pr_local_branch <- if (is.null(pr)) git_branch() else pr$pr_local_branch
if (!is.na(pr_local_branch)) {
if (pr_local_branch == git_branch()) {
challenge_uncommitted_changes()
}
tracking_branch <- git_branch_tracking(pr_local_branch)
if (is.na(tracking_branch)) {
if (ui_nah(c(
"!" = "Local branch {.val {pr_local_branch}} has no associated remote
branch.",
"i" = "If we delete {.val {pr_local_branch}}, any work that exists only
on this branch may be hard for you to recover.",
" " = "Proceed anyway?"
))) {
ui_bullets(c("x" = "Cancelling."))
return(invisible())
}
} else {
cmp <- git_branch_compare(
branch = pr_local_branch,
remref = tracking_branch
)
if (cmp$local_only > 0 && ui_nah(c(
"!" = "Local branch {.val {pr_local_branch}} has 1 or more commits that
have not been pushed to {.val {tracking_branch}}.",
"i" = "If we delete {.val {pr_local_branch}}, this work may be hard for
you to recover.",
" " = "Proceed anyway?"
))) {
ui_bullets(c("x" = "Cancelling."))
return(invisible())
}
}
}
if (git_branch() != default_branch) {
ui_bullets(c(
"v" = "Switching back to default branch ({.val {default_branch}})."
))
gert::git_branch_checkout(default_branch, force = TRUE, repo = repo)
pr_pull_source_override(tr = tr, default_branch = default_branch)
}
if (!is.na(pr_local_branch)) {
ui_bullets(c(
"v" = "Deleting local {.val {pr_local_branch}} branch."
))
gert::git_branch_delete(pr_local_branch, repo = repo)
}
if (is.null(pr)) {
return(invisible())
}
if (mode == "finish") {
pr_branch_delete(pr)
}
# delete remote, if we (usethis) added it AND no remaining tracking branches
created_by <- git_cfg_get(glue("remote.{pr$pr_remote}.created-by"))
if (is.null(created_by) || !grepl("^usethis::", created_by)) {
return(invisible())
}
branches <- gert::git_branch_list(local = TRUE, repo = repo)
branches <- branches[!is.na(branches$upstream), ]
if (sum(grepl(glue("^refs/remotes/{pr$pr_remote}"), branches$upstream)) == 0) {
ui_bullets(c("v" = "Removing remote {.val {pr$pr_remote}}."))
gert::git_remote_remove(remote = pr$pr_remote, repo = repo)
}
invisible()
}
# Make sure to pull from upstream/DEFAULT (as opposed to origin/DEFAULT) if
# we're in DEFAULT branch of a fork. I wish everyone set up DEFAULT to track the
# DEFAULT branch in the source repo, but this protects us against sub-optimal
# setup.
pr_pull_source_override <- function(tr = NULL, default_branch = NULL) {
# naive selection of target repo; calling function should analyse the config
tr <- tr %||% target_repo(github_get = FALSE, ask = FALSE)
# TODO: why does this not use a check_*() function, i.e. shared helper?
# I guess to issue a specific error message?
current_branch <- git_branch()
default_branch <- default_branch %||% git_default_branch()
if (current_branch != default_branch) {
ui_abort("
Internal error: {.fun pr_pull_source_override} should only be used when on
default branch.")
}
# guard against mis-configured forks, that have default branch tracking
# the fork (origin) instead of the source (upstream)
# TODO: should I just change the upstream tracking branch, i.e. fix it?
remref <- glue("{tr$remote}/{default_branch}")
if (is_online(tr$host)) {
ui_bullets(c("v" = "Pulling changes from {.val {remref}}."))
git_pull(remref = remref, verbose = FALSE)
} else {
ui_bullets(c(
"!" = "Can't reach {.val {tr$host}}, therefore unable to pull changes from
{.val {remref}}."
))
}
}
pr_create <- function() {
branch <- git_branch()
tracking_branch <- git_branch_tracking(branch)
remote <- remref_remote(tracking_branch)
remote_dat <- github_remotes(remote, github_get = FALSE)
ui_bullets(c("_" = "Create PR at link given below."))
view_url(glue_data(remote_dat, "{host_url}/{repo_spec}/compare/{branch}"))
}
# retrieves 1 PR, if:
# * we can establish a tracking relationship between `branch` and a PR branch
# * we can get the user to choose 1
pr_find <- function(branch = git_branch(),
tr = NULL,
state = c("open", "closed", "all")) {
# Have we done this before? Check if we've cached pr-url in git config.
config_url <- glue("branch.{branch}.pr-url")
url <- git_cfg_get(config_url, where = "local")
if (!is.null(url)) {
return(pr_get(number = sub("^.+pull/", "", url), tr = tr))
}
tracking_branch <- git_branch_tracking(branch)
if (is.na(tracking_branch)) {
return(NULL)
}
state <- match.arg(state)
remote <- remref_remote(tracking_branch)
remote_dat <- github_remotes(remote)
pr_head <- glue("{remote_dat$repo_owner}:{remref_branch(tracking_branch)}")
pr_dat <- pr_list(tr = tr, state = state, head = pr_head)
if (nrow(pr_dat) == 0) {
return(NULL)
}
if (nrow(pr_dat) > 1) {
spec <- sub(":", "/", pr_head)
ui_bullets(c("!" = "Multiple PRs are associated with {.val {spec}}."))
pr_dat <- choose_pr(pr_dat = pr_dat)
if (min(lengths(pr_dat)) == 0) {
ui_abort("
One of these PRs must be specified explicitly or interactively: \\
{.or {paste0('#', pr_dat$pr_number)}}.")
}
}
gert::git_config_set(config_url, pr_dat$pr_html_url, repo = git_repo())
as.list(pr_dat)
}
pr_url <- function(branch = git_branch(),
tr = NULL,
state = c("open", "closed", "all")) {
state <- match.arg(state)
pr <- pr_find(branch, tr = tr, state = state)
if (is.null(pr)) {
NULL
} else {
pr$pr_html_url
}
}
pr_data_tidy <- function(pr) {
out <- list(
pr_number = pluck_int(pr, "number"),
pr_title = pluck_chr(pr, "title"),
pr_state = pluck_chr(pr, "state"),
pr_user = pluck_chr(pr, "user", "login"),
pr_created_at = pluck_chr(pr, "created_at"),
pr_updated_at = pluck_chr(pr, "updated_at"),
pr_merged_at = pluck_chr(pr, "merged_at"),
pr_label = pluck_chr(pr, "head", "label"),
# the 'repo' element of 'head' is NULL when fork has been deleted
pr_repo_owner = pluck_chr(pr, "head", "repo", "owner", "login"),
pr_ref = pluck_chr(pr, "head", "ref"),
pr_repo_spec = pluck_chr(pr, "head", "repo", "full_name"),
pr_from_fork = pluck_lgl(pr, "head", "repo", "fork"),
# 'maintainer_can_modify' is only present when we GET one specific PR
pr_maintainer_can_modify = pluck_lgl(pr, "maintainer_can_modify"),
pr_https_url = pluck_chr(pr, "head", "repo", "clone_url"),
pr_ssh_url = pluck_chr(pr, "head", "repo", "ssh_url"),
pr_html_url = pluck_chr(pr, "html_url"),
pr_string = glue("
{pluck_chr(pr, 'base', 'repo', 'full_name')}/#{pluck_int(pr, 'number')}")
)
grl <- github_remote_list(these = NULL)
m <- match(out$pr_repo_spec, grl$repo_spec)
out$pr_remote <- if (is.na(m)) out$pr_repo_owner else grl$remote[m]
pr_remref <- glue("{out$pr_remote}/{out$pr_ref}")
gbl <- gert::git_branch_list(local = TRUE, repo = git_repo())
gbl <- gbl[!is.na(gbl$upstream), c("name", "upstream")]
gbl$upstream <- sub("^refs/remotes/", "", gbl$upstream)
m <- match(pr_remref, gbl$upstream)
out$pr_local_branch <- if (is.na(m)) NA_character_ else gbl$name[m]
# If the fork has been deleted, these are all NA
# - Because pr$head$repo is NULL:
# pr_repo_owner, pr_repo_spec, pr_from_fork, pr_https_url, pr_ssh_url
# - Because derived from those above:
# pr_remote, pr_remref pr_local_branch
# I suppose one could already have a local branch, if you fetched the PR
# before the fork got deleted.
# But an initial pr_fetch() won't work if the fork has been deleted.
# I'm willing to accept that the pr_*() functions don't necessarily address
# the "deleted fork" scenario. It's relatively rare.
# example: https://github.com/r-lib/httr/pull/634
out
}
pr_list <- function(tr = NULL,
github_get = NA,
state = c("open", "closed", "all"),
head = NULL) {
tr <- tr %||% target_repo(github_get = github_get, ask = FALSE)
state <- match.arg(state)
gh <- gh_tr(tr)
safely_gh <- purrr::safely(gh, otherwise = NULL)
out <- safely_gh(
"GET /repos/{owner}/{repo}/pulls",
state = state, head = head, .limit = Inf
)
if (is.null(out$error)) {
prs <- out$result
} else {
ui_bullets(c("x" = "Unable to retrieve PRs for {.value {tr$repo_spec}}."))
prs <- NULL
}
no_prs <- length(prs) == 0
if (no_prs) {
prs <- list(list())
}
out <- map(prs, pr_data_tidy)
out <- map(out, ~ as.data.frame(.x, stringsAsFactors = FALSE))
out <- do.call(rbind, out)
if (no_prs) {
out[0, ]
} else {
pr_is_open <- out$pr_state == "open"
rbind(out[pr_is_open, ], out[!pr_is_open, ])
}
}
# retrieves specific PR by number
pr_get <- function(number, tr = NULL, github_get = NA) {
tr <- tr %||% target_repo(github_get = github_get, ask = FALSE)
gh <- gh_tr(tr)
raw <- gh("GET /repos/{owner}/{repo}/pulls/{number}", number = number)
pr_data_tidy(raw)
}
branches_with_no_upstream_or_github_upstream <- function(tr = NULL) {
repo <- git_repo()
gb_dat <- gert::git_branch_list(local = TRUE, repo = repo)
gb_dat <- gb_dat[, c("name", "upstream", "updated")]
gb_dat$remref <- sub("^refs/remotes/", "", gb_dat$upstream)
gb_dat$upstream <- NULL
gb_dat$remote <- remref_remote(gb_dat$remref)
gb_dat$ref <- remref_branch(gb_dat$remref)
gb_dat$cfg_pr_url <- map_chr(
glue("branch.{gb_dat$name}.pr-url"),
~ git_cfg_get(.x, where = "local") %||% NA_character_
)
ghr <- github_remote_list(these = NULL)[["remote"]]
gb_dat <- gb_dat[is.na(gb_dat$remref) | (gb_dat$remote %in% ghr), ]
pr_dat <- pr_list(tr = tr)
dat <- merge(
x = gb_dat, y = pr_dat,
by.x = "name", by.y = "pr_local_branch",
all.x = TRUE
)
dat <- dat[order(dat$pr_number, dat$pr_updated_at, dat$updated, decreasing = TRUE), ]
missing_cfg <- is.na(dat$cfg_pr_url) & !is.na(dat$pr_html_url)
purrr::walk2(
glue("branch.{dat$name[missing_cfg]}.pr-url"),
dat$pr_html_url[missing_cfg],
~ gert::git_config_set(.x, .y, repo = repo)
)
dat
}
choose_branch <- function(exclude = character()) {
if (!is_interactive()) {
return(character())
}
dat <- branches_with_no_upstream_or_github_upstream()
dat <- dat[!dat$name %in% exclude, ]
if (nrow(dat) == 0) {
return()
}
prompt <- "Which branch do you want to checkout? (0 to exit)"
n_show_max <- 9
n <- nrow(dat)
n_shown <- compute_n_show(n, n_show_nominal = n_show_max)
n_not_shown <- n - n_shown
if (n_not_shown > 0) {
branches_not_shown <- utils::tail(dat$name, -n_shown)
dat <- dat[seq_len(n_shown), ]
fine_print <- cli::format_inline(
"{n_not_shown} branch{?/es} not listed: {.val {branches_not_shown}}"
)
prompt <- glue("{prompt}\n{fine_print}")
}
dat$pretty_name <- format(dat$name, justify = "right")
dat_pretty <- purrr::pmap_chr(
dat[c("pretty_name", "pr_number", "pr_html_url", "pr_user", "pr_title")],
function(pretty_name, pr_number, pr_html_url, pr_user, pr_title) {
if (is.na(pr_number)) {
pretty_name
} else {
href_number <- ui_pre_glue("{.href [PR #<<pr_number>>](<<pr_html_url>>)}")
at_user <- glue("@{pr_user}")
template <- ui_pre_glue(
"{pretty_name} {cli::symbol$arrow_right} <<href_number>> ({.field <<at_user>>}): {.val <<pr_title>>}"
)
cli::format_inline(template)
}
}
)
choice <- utils::menu(title = prompt, choices = cli::ansi_strtrim(dat_pretty))
dat$name[choice]
}
choose_pr <- function(tr = NULL, pr_dat = NULL) {
if (!is_interactive()) {
return(list(pr_number = list()))
}
if (is.null(pr_dat)) {
tr <- tr %||% target_repo()
pr_dat <- pr_list(tr)
}
if (nrow(pr_dat) == 0) {
return()
}
# wording needs to make sense for several PR-choosing tasks, e.g. fetch, view,
# finish, forget
prompt <- "Which PR are you interested in? (0 to exit)"
n_show_max <- 9
n <- nrow(pr_dat)
n_shown <- compute_n_show(n, n_show_nominal = n_show_max)
n_not_shown <- n - n_shown
if (n_not_shown > 0) {
pr_dat <- pr_dat[seq_len(n_shown), ]
info1 <- cli::format_inline("Not shown: {n_not_shown} more PR{?s}.")
info2 <- cli::format_inline(
"Call {.run usethis::browse_github_pulls()} to browse all PRs."
)
prompt <- glue("{prompt}\n{info1}\n{info2}")
}
some_closed <- any(pr_dat$pr_state == "closed")
pr_pretty <- purrr::pmap_chr(
pr_dat[c("pr_number", "pr_html_url", "pr_user", "pr_state", "pr_title")],
function(pr_number, pr_html_url, pr_user, pr_state, pr_title) {
href_number <- ui_pre_glue("{.href [PR #<<pr_number>>](<<pr_html_url>>)}")
at_user <- glue("@{pr_user}")
if (some_closed) {
template <- ui_pre_glue(
"<<href_number>> ({.field <<at_user>>}, {pr_state}): {.val <<pr_title>>}"
)
cli::format_inline(template)
} else {
template <- ui_pre_glue(
"<<href_number>> ({.field <<at_user>>}): {.val <<pr_title>>}"
)
cli::format_inline(template)
}
}
)
choice <- utils::menu(
title = prompt,
choices = cli::ansi_strtrim(pr_pretty)
)
as.list(pr_dat[choice, ])
}
# deletes the remote branch associated with a PR
# returns invisible TRUE/FALSE re: whether a deletion actually occurred
# reasons this returns FALSE
# * don't have push permission on remote where PR branch lives
# * PR has not been merged
# * remote branch has already been deleted
pr_branch_delete <- function(pr) {
remote <- pr$pr_remote
remote_dat <- github_remotes(remote)
if (!isTRUE(remote_dat$can_push)) {
return(invisible(FALSE))
}
gh <- gh_tr(remote_dat)
pr_ref <- tryCatch(
gh(
"GET /repos/{owner}/{repo}/git/ref/{ref}",
ref = glue("heads/{pr$pr_ref}")
),
http_error_404 = function(cnd) NULL
)
pr_remref <- glue_data(pr, "{pr_remote}/{pr_ref}")
if (is.null(pr_ref)) {
ui_bullets(c(
"i" = "PR {.href [{pr$pr_string}]({pr$pr_html_url})} originated from branch {.val {pr_remref}},
which no longer exists."
))
return(invisible(FALSE))
}
if (is.na(pr$pr_merged_at)) {
ui_bullets(c(
"i" = "PR {.href [{pr$pr_string}]({pr$pr_html_url})} is unmerged, we will not delete the
remote branch {.val {pr_remref}}."
))
return(invisible(FALSE))
}
ui_bullets(c(
"v" = "PR {.href [{pr$pr_string}]({pr$pr_html_url})} has been merged, deleting remote branch
{.val {pr_remref}}."
))
# TODO: tryCatch here?
gh(
"DELETE /repos/{owner}/{repo}/git/refs/{ref}",
ref = glue("heads/{pr$pr_ref}")
)
invisible(TRUE)
}
check_pr_branch <- function(default_branch = git_default_branch()) {
# the glue-ing happens inside check_current_branch(), where `gb` gives the
# current git branch
check_current_branch(
is_not = default_branch,
message = c(
"i" = "The {.code pr_*()} functions facilitate pull requests.",
"i" = "The current branch ({.val {gb}}) is this repo's default branch, but
pull requests should NOT come from the default branch.",
"i" = "Do you need to call {.fun usethis::pr_init} (new PR)?
Or {.fun usethis::pr_resume} or
{.fun usethis::pr_fetch} (existing PR)?"
)
)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.