Where possible use existing github config when determining default br…

…anch

Fixes #2021

R/git-default-branch.R

@@ -93,39 +93,18 @@ NULL
 #' git_default_branch()
 #' }
 git_default_branch <- function() {
- repo <- git_repo()
+ git_default_branch_(github_remote_config())
+}
 
- # TODO: often when we call git_default_branch(), we already have a GitHub
- # configuration or target repo, as produced by github_remote_config() or
- # target_repo(). In that case, we don't need to start from scratch as we do
- # here. But I'm not sure it's worth adding complexity to allow passing this
- # data in.
-
- # TODO: this critique feels somewhat mis-placed, i.e. it brings up a general
- # concern about a repo's config (or the user's permissions and creds)
- # related to whether github_remotes() should be as silent as it is about
- # 404s
- critique_remote <- function(remote) {
- if (remote$is_configured && is.na(remote$default_branch)) {
- ui_bullets(c(
- "x" = "The {.val {remote$name}} remote is configured, but we can't
- determine its default branch.",
- " " = "Possible reasons:",
- "*" = "The remote repo no longer exists, suggesting the local remote
- should be deleted.",
- "*" = "We are offline or that specific Git server is down.",
- "*" = "You don't have the necessary permission or something is wrong
- with your credentials."
- ))
- }
- }
+# If config is available, we can use it to avoid an additional lookup
+# on the GitHub API
+git_default_branch_ <- function(cfg) {
+ repo <- git_repo()
 
- upstream <- git_default_branch_remote("upstream")
+ upstream <- git_default_branch_remote(cfg, "upstream")
  if (is.na(upstream$default_branch)) {
- critique_remote(upstream)
- origin <- git_default_branch_remote("origin")
+ origin <- git_default_branch_remote(cfg, "origin")
  if (is.na(origin$default_branch)) {
- critique_remote(origin)
  db_source <- list()
  } else {
  db_source <- origin
@@ -186,7 +165,7 @@ git_default_branch <- function() {
 
 # returns a whole data structure, because the caller needs the surrounding
 # context to produce a helpful error message
-git_default_branch_remote <- function(remote = "origin") {
+git_default_branch_remote <- function(cfg, remote = "origin") {
  repo <- git_repo()
  out <- list(
  name = remote,
@@ -196,25 +175,22 @@ git_default_branch_remote <- function(remote = "origin") {
  default_branch = NA_character_
  )
 
- url <- git_remotes()[[remote]]
- if (length(url) == 0) {
+ cfg_remote <- cfg[[remote]]
+ if (!cfg_remote$is_configured) {
  out$is_configured <- FALSE
  return(out)
  }
+
  out$is_configured <- TRUE
- out$url <- url
-
- # TODO: generalize here for GHE hosts that don't include 'github'
- parsed <- parse_github_remotes(url)
- # if the protocol is ssh, I suppose we can't assume a PAT, i.e. it's better
- # to use the Git approach vs. the GitHub API approach
- if (grepl("github", parsed$host) && parsed$protocol == "https") {
- remote_dat <- github_remotes(remote, github_get = NA)
- out$repo_spec <- remote_dat$repo_spec
- out$default_branch <- remote_dat$default_branch
+ out$url <- cfg_remote$url
+
+ if (!is.na(cfg_remote$default_branch)) {
+ out$repo_spec <- cfg_remote$repo_spec
+ out$default_branch <- cfg_remote$default_branch
  return(out)
  }
 
+ # Fall back to pure git based approach
  out$default_branch <- tryCatch(
  {
  gert::git_fetch(remote = remote, repo = repo, verbose = FALSE)

R/pr.R

@@ -184,7 +184,7 @@ pr_init <- function(branch) {
  }
  }
 
- default_branch <- git_default_branch()
+ default_branch <- git_default_branch_(cfg)
  challenge_non_default_branch(
  "Are you sure you want to create a PR branch based on a non-default branch?",
  default_branch = default_branch
@@ -375,7 +375,7 @@ 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()
+ default_branch <- git_default_branch_(cfg)
  check_pr_branch(default_branch)
  challenge_uncommitted_changes()
 
@@ -423,7 +423,7 @@ pr_push <- function() {
 pr_pull <- function() {
  cfg <- github_remote_config(github_get = TRUE)
  check_for_config(cfg)
- default_branch <- git_default_branch()
+ default_branch <- git_default_branch_(cfg)
  check_pr_branch(default_branch)
  challenge_uncommitted_changes()
 
@@ -449,11 +449,12 @@ pr_merge_main <- function() {
 #' @export
 #' @rdname pull-requests
 pr_view <- function(number = NULL, target = c("source", "primary")) {
- tr <- target_repo(github_get = NA, role = target, ask = FALSE)
+ cfg <- github_remote_config(github_get = NA)
+ tr <- target_repo(cfg, github_get = NA, role = target, ask = FALSE)
  url <- NULL
  if (is.null(number)) {
  branch <- git_branch()
- default_branch <- git_default_branch()
+ default_branch <- git_default_branch_(cfg)
  if (branch != default_branch) {
  url <- pr_url(branch = branch, tr = tr)
  if (is.null(url)) {
@@ -491,11 +492,11 @@ pr_view <- function(number = NULL, target = c("source", "primary")) {
 #' @export
 #' @rdname pull-requests
 pr_pause <- function() {
- # intentionally naive selection of target repo
- tr <- target_repo(github_get = FALSE, ask = FALSE)
+ cfg <- github_remote_config(github_get = NA)
+ tr <- target_repo(cfg, github_get = NA, ask = FALSE)
 
  ui_bullets(c("v" = "Switching back to the default branch."))
- default_branch <- git_default_branch()
+ default_branch <- git_default_branch_(cfg)
  if (git_branch() == default_branch) {
  ui_bullets(c(
  "!" = "Already on this repo's default branch ({.val {default_branch}}),
@@ -535,8 +536,10 @@ pr_clean <- function(number = NULL,
  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()
+
+ cfg <- github_remote_config(github_get = NA)
+ tr <- target_repo(cfg, github_get = NA, role = target, ask = FALSE)
+ default_branch <- git_default_branch_(cfg)
 
  if (is.null(number)) {
  check_pr_branch(default_branch)
@@ -994,7 +997,7 @@ pr_branch_delete <- function(pr) {
  invisible(TRUE)
 }
 
-check_pr_branch <- function(default_branch = git_default_branch()) {
+check_pr_branch <- function(default_branch) {
  # the glue-ing happens inside check_current_branch(), where `gb` gives the
  # current git branch
  check_current_branch(

tests/testthat/helper-mocks.R

@@ -28,7 +28,7 @@ local_ui_yep <- function(.env = caller_env()) {
 
 local_git_default_branch_remote <- function(.env = caller_env()) {
  local_mocked_bindings(
- git_default_branch_remote = function(remote) {
+ git_default_branch_remote = function(cfg, remote) {
  list(
  name = remote,
  is_configured = TRUE,