Harden use_github() re: partial setup (r-lib#516)

* Break use_github flow into smaller pieces

Now checks individual for origin remote (i.e. is there a GitHub repo), description fields, and push-ability for master.

Fixes r-lib#221

* Be consistent with create_from_github(), use_tidy_thanks()

  We're trying to standardize on "repo_spec" to refer to a "owner/repo"
  combination

* Open repo in browser after we (hopefully) have pushed

* Add more tips for getting the git situation sorted out for use_github()

* Remove `base_path` and `path` arguments from git and github helpers

* Consistent approach to multi-line ui_stop()

* More consistent if {} else {} style

DESCRIPTION

@@ -33,6 +33,7 @@ Imports:
     rlang,
     rprojroot (>= 1.2),
     rstudioapi,
+    stats,
     utils,
     whisker,
     withr,

NEWS.md

@@ -2,6 +2,8 @@
 
 ## New features
 
+* `use_github()` tries harder but also fails earlier, with more informative messages, making it less likely to leave the repo partially configured (#221).
+
 * `git_sitrep()` lets you know what's up with your git, git2r and GitHub 
   config (#328).
 

R/badge.R

@@ -114,7 +114,6 @@ stages <- c(
 #' @rdname badges
 #' @export
 use_binder_badge <- function() {
-
   if (uses_github()) {
     url <- glue("https://mybinder.org/v2/gh/{github_repo_spec()}/master")
     img <- "http://mybinder.org/badge.svg"
@@ -141,12 +140,14 @@ badge_end <- "<!-- badges: end -->"
 
 find_readme <- function() {
   Rmd <- proj_path("README.Rmd")
-  if (file_exists(Rmd))
+  if (file_exists(Rmd)) {
     return(Rmd)
+  }
 
   md <- proj_path("README.md")
-  if (file_exists(md))
+  if (file_exists(md)) {
     return(md)
+  }
 
   NULL
 }

R/block.R

@@ -2,8 +2,9 @@ block_append <- function(desc, value, path, block_start, block_end,
                          block_prefix = NULL, block_suffix = NULL) {
   if (!is.null(path) && file_exists(path)) {
     lines <- readLines(path)
-    if (value %in% lines)
+    if (value %in% lines) {
       return(FALSE)
+    }
 
     block_lines <- block_find(lines, block_start, block_end)
   } else {
@@ -74,15 +75,17 @@ block_show <- function(path, block_start, block_end) {
 
 block_find <- function(lines, block_start, block_end) {
   # No file
-  if (is.null(lines))
+  if (is.null(lines)) {
     return(NULL)
+  }
 
   start <- which(lines == block_start)
   end <- which(lines == block_end)
 
   # No block
-  if (length(start) == 0 && length(end) == 0)
+  if (length(start) == 0 && length(end) == 0) {
     return(NULL)
+  }
 
   if (!(length(start) == 1 && length(end) == 1 && start < end)) {
     ui_stop(

R/browse.R

@@ -83,8 +83,7 @@ github_link <- function(package = NULL) {
   if (length(gh_links) == 0) {
     ui_warn("
       Package does not provide a GitHub URL.
-      Falling back to GitHub CRAN mirror"
-    )
+      Falling back to GitHub CRAN mirror")
     return(glue("https://github.com/cran/{package}"))
   }
 
@@ -124,9 +123,9 @@ github_home <- function(package = NULL) {
 ## inline a simplified version of rematch2::re_match()
 re_match_inline <- function(text, pattern) {
   match <- regexpr(pattern, text, perl = TRUE)
-  start  <- as.vector(match)
+  start <- as.vector(match)
   length <- attr(match, "match.length")
-  end    <- start + length - 1L
+  end <- start + length - 1L
 
   matchstr <- substring(text, start, end)
   matchstr[ start == -1 ] <- NA_character_
@@ -138,10 +137,9 @@ re_match_inline <- function(text, pattern) {
   )
 
   if (!is.null(attr(match, "capture.start"))) {
-
-    gstart  <- attr(match, "capture.start")
+    gstart <- attr(match, "capture.start")
     glength <- attr(match, "capture.length")
-    gend    <- gstart + glength - 1L
+    gend <- gstart + glength - 1L
 
     groupstr <- substring(text, gstart, gend)
     groupstr[ gstart == -1 ] <- NA_character_

R/ci.R

@@ -97,12 +97,12 @@ appveyor_activate <- function(browse = interactive()) {
 }
 
 use_appveyor_badge <- function() {
-  appveyor <- appveyor_info(proj_get())
+  appveyor <- appveyor_info()
   use_badge("AppVeyor build status", appveyor$url, appveyor$img)
 }
 
-appveyor_info <- function(base_path = proj_get()) {
-  check_uses_github(base_path)
+appveyor_info <- function() {
+  check_uses_github()
   img <- glue(
     "https://ci.appveyor.com/api/projects/status/github/",
     "{github_repo_spec()}?branch=master&svg=true"

R/course.R

@@ -337,8 +337,9 @@ progress_fun <- function(down, up) {
   } else {
     ""
   }
-  if(now > 10000)
+  if (now > 10000) {
     cat("\rDownloaded:", sprintf("%.2f", now / 2^20), "MB ", pct)
+  }
   TRUE
 }
 

R/git-utils.R

@@ -2,7 +2,7 @@
 
 git_repo <- function() {
   check_uses_git()
-  git2r::repository(proj_path())
+  git2r::repository(proj_get())
 }
 
 git_init <- function() {
@@ -23,6 +23,20 @@ uses_git <- function(path = proj_get()) {
   !is.null(git2r::discover_repository(path))
 }
 
+# Remotes ------------------------------------------------------------------
+git_remotes <- function() {
+  r <- git_repo()
+  rnames <- git2r::remotes(r)
+  if (length(rnames) == 0) return(NULL)
+  stats::setNames(as.list(git2r::remote_url(r, rnames)), rnames)
+}
+
+git_remote_find <- function(rname = "origin") {
+  remotes <- git_remotes()
+  if (length(remotes) == 0) return(NULL)
+  remotes[[rname]]
+}
+
 # Commit ------------------------------------------------------------------
 
 git_commit_find <- function(refspec = NULL) {
@@ -111,12 +125,10 @@ check_uses_git <- function(base_path = proj_get()) {
     return(invisible())
   }
 
-  ui_stop(
-    "
-    Cannot detect that project is already a Git repository.
-    Do you need to run {ui_code('use_git()')}?
-    "
-  )
+  ui_stop(c(
+    "Cannot detect that project is already a Git repository.",
+    "Do you need to run {ui_code('use_git()')}?"
+  ))
 }
 
 check_uncommitted_changes <- function(path = proj_get()) {
@@ -148,6 +160,20 @@ check_branch_not_master <- function() {
   )
 }
 
+check_branch <- function(branch) {
+  ui_done("Checking that current branch is {ui_value(branch)}")
+  actual <- git_branch_name()
+  if (actual == branch) return()
+  code <- glue("git checkout {branch}")
+  ui_stop(
+    "
+    Must be on branch {ui_value(branch)}, not {ui_value(actual)}.
+    How to switch to the correct branch in the shell:
+    {ui_code(code)}
+    "
+  )
+}
+
 check_branch_current <- function(branch = git_branch_name()) {
   ui_done("Checking that {ui_value(branch)} branch is up to date")
   diff <- git_branch_compare(branch)

R/git.R

@@ -26,12 +26,14 @@ use_git <- function(message = "Initial commit") {
 }
 
 git_ask_commit <- function(message) {
-  if (!interactive())
+  if (!interactive()) {
     return(invisible())
+  }
 
   paths <- unlist(git_status(), use.names = FALSE)
-  if (length(paths) == 0)
+  if (length(paths) == 0) {
     return(invisible())
+  }
 
   paths <- sort(paths)
 
@@ -216,4 +218,3 @@ git_global_ignore <- c(
   ".Rdata",
   ".DS_Store"
 )
-

R/github-labels.R

@@ -22,8 +22,8 @@
 #' * `good first issue` indicates a good issue for first-time contributors.
 #' * `help wanted` indicates that a maintainer wants help on an issue.
 #'
-#' @param repo Optional repository specification (`owner/repo`) if you
-#'   don't want to use the current project.
+#' @param repo_spec Optional repository specification (`owner/repo`) if you
+#'   don't want to target the current project.
 #' @param labels A character vector giving labels to add.
 #' @param rename A named vector with names giving old names and values giving
 #'   new values.
@@ -56,8 +56,7 @@
 #'   descriptions = c("foofiest" = "the foofiest issue you ever saw")
 #' )
 #' }
-use_github_labels <- function(
-                              repo = github_repo_spec(),
+use_github_labels <- function(repo_spec = github_repo_spec(),
                               labels = character(),
                               rename = character(),
                               colours = character(),
@@ -71,8 +70,8 @@ use_github_labels <- function(
     out <- gh::gh(
       endpoint,
       ...,
-      owner = spec_owner(repo),
-      repo = spec_repo(repo),
+      owner = spec_owner(repo_spec),
+      repo = spec_repo(repo_spec),
       .token = auth_token,
       .api_url = host,
       .send_headers = c(
@@ -177,11 +176,11 @@ use_github_labels <- function(
 
 #' @export
 #' @rdname use_github_labels
-use_tidy_labels <- function(repo = github_repo_spec(),
+use_tidy_labels <- function(repo_spec = github_repo_spec(),
                             auth_token = NULL,
                             host = NULL) {
   use_github_labels(
-    repo = repo,
+    repo_spec = repo_spec,
     labels = tidy_labels(),
     rename = tidy_labels_rename(),
     colours = tidy_label_colours(),

R/github-utils.R

@@ -1,24 +1,30 @@
-## suppress the warning about multiple remotes, which is triggered by
-## the common "origin" and "upstream" situation, e.g., fork and clone
-gh_tree_remote <- function(path) {
-  suppressWarnings(gh::gh_tree_remote(path))
+github_remotes <- function() {
+  remotes <- git_remotes()
+  if (length(remotes) == 0) return(NULL)
+  m <- vapply(remotes, function(x) grepl("github", x), logical(1))
+  if (length(m) == 0) return(NULL)
+  remotes[m]
 }
 
-## Git remotes --> filter for GitHub --> owner, repo, repo_spec
-github_owner <- function(path = proj_get()) {
-  gh_tree_remote(path)[["username"]]
+github_origin <- function() {
+  r <- github_remotes()
+  if (length(r) == 0) return(NULL)
+  parse_github_remotes(r)[["origin"]]
 }
 
-github_repo <- function(path = proj_get()) {
-  gh_tree_remote(path)[["repo"]]
+github_owner <- function() {
+  github_origin()[["owner"]]
 }
 
-github_repo_spec <- function(path = proj_get()) {
-  paste0(gh_tree_remote(path), collapse = "/")
+github_repo <- function() {
+  github_origin()[["repo"]]
+}
+
+github_repo_spec <- function() {
+  paste0(github_origin(), collapse = "/")
 }
 
 ## repo_spec --> owner, repo
-## TODO: could use more general facilities for parsing GitHub URL/spec
 parse_repo_spec <- function(repo_spec) {
   repo_split <- strsplit(repo_spec, "/")[[1]]
   if (length(repo_split) != 2) {
@@ -29,3 +35,16 @@ parse_repo_spec <- function(repo_spec) {
 
 spec_owner <- function(repo_spec) parse_repo_spec(repo_spec)$owner
 spec_repo <- function(repo_spec) parse_repo_spec(repo_spec)$repo
+
+## named vector or list of Git remote URLs --> named list of (owner, repo)
+parse_github_remotes <- function(x) {
+  # https://github.com/r-lib/devtools.git --> rlib, devtools
+  # https://github.com/r-lib/devtools     --> rlib, devtools
+  # [email protected]:r-lib/devtools.git     --> rlib, devtools
+  re <- "github[^/:]*[/:]([^/]+)/(.*?)(?:\\.git)?$"
+  ## on R < 3.4.2, regexec() fails to apply as.character() to first 2 args,
+  ## though it is documented
+  m <- regexec(re, as.character(x))
+  match <- stats::setNames(regmatches(as.character(x), m), names(x))
+  lapply(match, function(y) list(owner = y[[2]], repo = y[[3]]))
+}