R/git.R

Defines functions git_vaccinated git_vaccinate default_branch_sitrep git_sitrep git_clean git_remotes use_git_remote check_protocol use_git_protocol git_protocol use_git_config use_git_ignore use_git_hook use_git

Documented in git_protocol git_remotes git_sitrep git_vaccinate use_git use_git_config use_git_hook use_git_ignore use_git_protocol use_git_remote

#' Initialise a git repository
#'
#' `use_git()` initialises a Git repository and adds important files to
#' `.gitignore`. If user consents, it also makes an initial commit.
#'
#' @param message Message to use for first commit.
#' @family git helpers
#' @export
#' @examples
#' \dontrun{
#' use_git()
#' }
use_git <- function(message = "Initial commit") {
  needs_init <- !uses_git()
  if (needs_init) {
    ui_done("Initialising Git repo")
    git_init()
  }

  use_git_ignore(git_ignore_lines)
  if (git_uncommitted(untracked = TRUE)) {
    git_ask_commit(message, untracked = TRUE)
  }

  if (needs_init) {
    restart_rstudio("A restart of RStudio is required to activate the Git pane")
  }

  invisible(TRUE)
}

#' Add a git hook
#'
#' Sets up a git hook using specified script. Creates hook directory if
#' needed, and sets correct permissions on hook.
#'
#' @param hook Hook name. One of "pre-commit", "prepare-commit-msg",
#'   "commit-msg", "post-commit", "applypatch-msg", "pre-applypatch",
#'   "post-applypatch", "pre-rebase", "post-rewrite", "post-checkout",
#'   "post-merge", "pre-push", "pre-auto-gc".
#' @param script Text of script to run
#' @family git helpers
#' @export
use_git_hook <- function(hook, script) {
  check_uses_git()

  hook_path <- proj_path(".git", "hooks", hook)
  create_directory(path_dir(hook_path))

  write_over(hook_path, script)
  file_chmod(hook_path, "0744")

  invisible()
}

#' Tell Git to ignore files
#'
#' @param ignores Character vector of ignores, specified as file globs.
#' @param directory Directory relative to active project to set ignores
#' @family git helpers
#' @export
use_git_ignore <- function(ignores, directory = ".") {
  write_union(proj_path(directory, ".gitignore"), ignores)
  rstudio_git_tickle()
}

#' Configure Git
#'
#' Sets Git options, for either the user or the project ("global" or "local", in
#' Git terminology). Wraps [gert::git_config_set()] and
#' [gert::git_config_global_set()]. To inspect Git config, see
#' [gert::git_config()].
#'
#' @param ... Name-value pairs, processed as
#'   <[`dynamic-dots`][rlang::dyn-dots]>.
#'
#' @return Invisibly, the previous values of the modified components, as a named
#'   list.
#' @inheritParams edit
#'
#' @family git helpers
#' @export
#' @examples
#' \dontrun{
#' # set the user's global user.name and user.email
#' use_git_config(user.name = "Jane", user.email = "jane@example.org")
#'
#' # set the user.name and user.email locally, i.e. for current repo/project
#' use_git_config(
#'   scope = "project",
#'   user.name = "Jane",
#'   user.email = "jane@example.org"
#' )
#' }
use_git_config <- function(scope = c("user", "project"), ...) {
  scope <- match.arg(scope)

  dots <- list2(...)
  stopifnot(is_dictionaryish(dots))

  orig <- stats::setNames(
    vector(mode = "list", length = length(dots)),
    names(dots)
  )
  for (i in seq_along(dots)) {
    nm <- names(dots)[[i]]
    vl <- dots[[i]]
    if (scope == "user") {
      orig[nm] <- git_cfg_get(nm, "global") %||% list(NULL)
      gert::git_config_global_set(nm, vl)
    } else {
      check_uses_git()
      orig[nm] <- git_cfg_get(nm, "local") %||% list(NULL)
      gert::git_config_set(nm, vl, repo = git_repo())
    }
  }

  invisible(orig)
}

#' See or set the default Git protocol
#'
#' @description
#' Git operations that address a remote use a so-called "transport protocol".
#' usethis supports HTTPS and SSH. The protocol dictates the Git URL format used
#' when usethis needs to configure the first GitHub remote for a repo:
#' * `protocol = "https"` implies `https://github.com/<OWNER>/<REPO>.git`
#' * `protocol = "ssh"` implies `git@@github.com:<OWNER>/<REPO>.git`
#'
#' Two helper functions are available:
#'   * `git_protocol()` reveals the protocol "in force". As of usethis v2.0.0,
#'     this defaults to "https". You can change this for the duration of the
#'     R session with `use_git_protocol()`. Change the default for all R
#'     sessions with code like this in your `.Rprofile` (easily editable via
#'     [edit_r_profile()]):
#'     ```
#'     options(usethis.protocol = "ssh")
#'     ```
#'   * `use_git_protocol()` sets the Git protocol for the current R session
#'
#' This protocol only affects the Git URL for newly configured remotes. All
#' existing Git remote URLs are always respected, whether HTTPS or SSH.
#'
#' @param protocol One of "https" or "ssh"
#'
#' @return The protocol, either "https" or "ssh"
#' @export
#'
#' @examples
#' \dontrun{
#' git_protocol()
#'
#' use_git_protocol("ssh")
#' git_protocol()
#'
#' use_git_protocol("https")
#' git_protocol()
#' }
git_protocol <- function() {
  protocol <- tolower(getOption("usethis.protocol", "unset"))
  if (identical(protocol, "unset")) {
    ui_info("Defaulting to {ui_value('https')} Git protocol")
    protocol <- "https"
  } else {
    check_protocol(protocol)
  }
  options("usethis.protocol" = protocol)
  getOption("usethis.protocol")
}

#' @rdname git_protocol
#' @export
use_git_protocol <- function(protocol) {
  options("usethis.protocol" = protocol)
  invisible(git_protocol())
}

check_protocol <- function(protocol) {
  if (!is_string(protocol) ||
      !(tolower(protocol) %in% c("https", "ssh"))) {
    options(usethis.protocol = NULL)
    ui_stop("
      {ui_code('protocol')} must be either {ui_value('https')} or \\
      {ui_value('ssh')}")
  }
  invisible()
}

#' Configure and report Git remotes
#'
#' Two helpers are available:
#'   * `use_git_remote()` sets the remote associated with `name` to `url`.
#'   * `git_remotes()` reports the configured remotes, similar to
#'     `git remote -v`.
#'
#' @param name A string giving the short name of a remote.
#' @param url A string giving the url of a remote.
#' @param overwrite Logical. Controls whether an existing remote can be
#'   modified.
#'
#' @return Named list of Git remotes.
#' @export
#'
#' @examples
#' \dontrun{
#' # see current remotes
#' git_remotes()
#'
#' # add new remote named 'foo', a la `git remote add <name> <url>`
#' use_git_remote(name = "foo", url = "https://github.com/<OWNER>/<REPO>.git")
#'
#' # remove existing 'foo' remote, a la `git remote remove <name>`
#' use_git_remote(name = "foo", url = NULL, overwrite = TRUE)
#'
#' # change URL of remote 'foo', a la `git remote set-url <name> <newurl>`
#' use_git_remote(
#'   name = "foo",
#'   url = "https://github.com/<OWNER>/<REPO>.git",
#'   overwrite = TRUE
#' )
#'
#' # Scenario: Fix remotes when you cloned someone's repo, but you should
#' # have fork-and-cloned (in order to make a pull request).
#'
#' # Store origin = main repo's URL, e.g., "git@github.com:<OWNER>/<REPO>.git"
#' upstream_url <- git_remotes()[["origin"]]
#'
#' # IN THE BROWSER: fork the main GitHub repo and get your fork's remote URL
#' my_url <- "git@github.com:<ME>/<REPO>.git"
#'
#' # Rotate the remotes
#' use_git_remote(name = "origin", url = my_url)
#' use_git_remote(name = "upstream", url = upstream_url)
#' git_remotes()
#'
#' # Scenario: Add upstream remote to a repo that you fork-and-cloned, so you
#' # can pull upstream changes.
#' # Note: If you fork-and-clone via `usethis::create_from_github()`, this is
#' # done automatically!
#'
#' # Get URL of main GitHub repo, probably in the browser
#' upstream_url <- "git@github.com:<OWNER>/<REPO>.git"
#' use_git_remote(name = "upstream", url = upstream_url)
#' }
use_git_remote <- function(name = "origin", url, overwrite = FALSE) {
  stopifnot(is_string(name))
  stopifnot(is.null(url) || is_string(url))
  stopifnot(is_true(overwrite) || is_false(overwrite))

  remotes <- git_remotes()
  repo <- git_repo()

  if (name %in% names(remotes) && !overwrite) {
    ui_stop("
      Remote {ui_value(name)} already exists. Use \\
      {ui_code('overwrite = TRUE')} to edit it anyway.")
  }

  if (name %in% names(remotes)) {
    if (is.null(url)) {
      gert::git_remote_remove(remote = name, repo = repo)
    } else {
      gert::git_remote_set_url(url = url, remote = name, repo = repo)
    }
  } else if (!is.null(url)) {
    gert::git_remote_add(url = url, name = name, repo = repo)
  }

  invisible(git_remotes())
}

#' @rdname use_git_remote
#' @export
git_remotes <- function() {
  x <- gert::git_remote_list(repo = git_repo())
  if (nrow(x) == 0) {
    return(NULL)
  }
  stats::setNames(as.list(x$url), x$name)
}

# unexported function to improve my personal quality of life
git_clean <- function() {
  if (!is_interactive() || !uses_git()) {
    return(invisible())
  }

  st <- gert::git_status(staged = FALSE, repo = git_repo())
  paths <- st[st$status == "new", ][["file"]]
  n <- length(paths)
  if (n == 0) {
    ui_info("Found no untracked files")
    return(invisible())
  }

  paths <- sort(paths)
  ui_paths <- map_chr(paths, ui_path)
  if (n > 10) {
    ui_paths <- c(ui_paths[1:10], "...")
  }

  if (n == 1) {
    file_hint <- "There is 1 untracked file:"
  } else {
    file_hint <- "There are {n} untracked files:"
  }
  ui_line(c(
    file_hint,
    paste0("* ", ui_paths)
  ))

  if (ui_yeah("

    Do you want to remove {if (n == 1) 'it' else 'them'}?",
    yes = "yes", no = "no", shuffle = FALSE)) {
    file_delete(paths)
    ui_done("{n} file(s) deleted")
  }
  rstudio_git_tickle()
  invisible()
}

#' Git/GitHub sitrep
#'
#' Get a situation report on your current Git/GitHub status. Useful for
#' diagnosing problems. [git_vaccinate()] adds some basic R- and RStudio-related
#' entries to the user-level git ignore file.
#' @export
#' @examples
#' \dontrun{
#' git_sitrep()
#' }
git_sitrep <- function() {
  ui_silence(try(proj_get(), silent = TRUE))

  # git (global / user) --------------------------------------------------------
  hd_line("Git config (global)")
  kv_line("Name", git_cfg_get("user.name", "global"))
  kv_line("Email", git_cfg_get("user.email", "global"))
  kv_line("Global (user-level) gitignore file", git_ignore_path("user"))
  vaccinated <- git_vaccinated()
  kv_line("Vaccinated", vaccinated)
  if (!vaccinated) {
    ui_info("See {ui_code('?git_vaccinate')} to learn more")
  }
  kv_line("Default Git protocol", git_protocol())
  init_default_branch <- git_cfg_get("init.defaultBranch", where = "global")
  kv_line("Default initial branch name", init_default_branch)

  # github (global / user) -----------------------------------------------------
  hd_line("GitHub")
  default_gh_host <- get_hosturl(default_api_url())
  kv_line("Default GitHub host", default_gh_host)
  pat_sitrep(default_gh_host)

  # git and github for active project ------------------------------------------
  hd_line("Git repo for current project")

  if (!proj_active()) {
    ui_info("No active usethis project")
    return(invisible())
  }
  kv_line("Active usethis project", proj_get())
  if (!uses_git()) {
    ui_info("Active project is not a Git repo")
    return(invisible())
  }

  # local git config -----------------------------------------------------------
  if (proj_active() && uses_git()) {
    local_user <- list(
      user.name = git_cfg_get("user.name", "local"),
      user.email = git_cfg_get("user.email", "local")
    )
    if (!is.null(local_user$user.name) || !is.null(local_user$user.name)) {
      ui_info("This repo has a locally configured user")
      kv_line("Name", local_user$user.name)
      kv_line("Email", local_user$user.email)
    }
  }

  # default branch -------------------------------------------------------------
  default_branch_sitrep()

  # current branch -------------------------------------------------------------
  branch <- tryCatch(git_branch(), error = function(e) NULL)
  tracking_branch <- if (is.null(branch)) NA_character_ else git_branch_tracking()
  # TODO: can't really express with kv_line() helper
  branch <- if (is.null(branch)) "<unset>" else branch
  tracking_branch <- if (is.na(tracking_branch)) "<unset>" else tracking_branch
  # vertical alignment would make this nicer, but probably not worth it
  ui_bullet(glue("
    Current local branch -> remote tracking branch:
    {ui_value(branch)} -> {ui_value(tracking_branch)}"))

  # GitHub remote config -------------------------------------------------------
  cfg <- github_remote_config()
  repo_host <- cfg$host_url
  if (!is.na(repo_host) && repo_host != default_gh_host) {
    kv_line("Non-default GitHub host", repo_host)
    pat_sitrep(repo_host, scold_for_renviron = FALSE)
  }

  hd_line("GitHub remote configuration")
  purrr::walk(format(cfg), ui_bullet)
  invisible()
}

# TODO: when I really overhaul the UI, determine if I can just re-use the
# git_default_branch() error messages in the sitrep
# the main point is converting an error to an "oops" type of message
default_branch_sitrep <- function() {
  tryCatch(
    kv_line("Default branch", git_default_branch()),
    error_default_branch = function(e) {
      if (has_name(e, "db_local")) {
        # FYI existence of db_local implies existence of db_source
        ui_oops("
          Default branch mismatch between local repo and remote!
          {ui_value(e$db_source$name)} remote default branch: \\
          {ui_value(e$db_source$default_branch)}
          Local default branch: {ui_value(e$db_local)}
          Call {ui_code('git_default_branch_rediscover()')} to resolve this.")
      } else if (has_name(e, "db_source")) {
        ui_oops("
          Default branch mismatch between local repo and remote!
          {ui_value(e$db_source$name)} remote default branch: \\
          {ui_value(e$db_source$default_branch)}
          Local repo has no branch by that name nor any other obvious candidates.
          Call {ui_code('git_default_branch_rediscover()')} to resolve this.")
      } else {
        ui_oops("Default branch cannot be determined.")
      }
    }
  )
}

# Vaccination -------------------------------------------------------------

#' Vaccinate your global gitignore file
#'
#' Adds `.DS_Store`, `.Rproj.user`, `.Rdata`, `.Rhistory`, and `.httr-oauth` to
#' your global (a.k.a. user-level) `.gitignore`. This is good practice as it
#' decreases the chance that you will accidentally leak credentials to GitHub.
#' `git_vaccinate()` also tries to detect and fix the situation where you have a
#' global gitignore file, but it's missing from your global Git config.
#'
#' @export
git_vaccinate <- function() {
  ensure_core_excludesFile()
  path <- git_ignore_path(scope = "user")
  if (!file_exists(path)) {
    ui_done("Creating the global (user-level) gitignore: {ui_path(path)}")
  }
  write_union(path, git_ignore_lines)
}

git_vaccinated <- function() {
  path <- git_ignore_path("user")
  if (is.null(path) || !file_exists(path)) {
    return(FALSE)
  }
  lines <- read_utf8(path)
  all(git_ignore_lines %in% lines)
}

git_ignore_lines <- c(
  ".Rproj.user",
  ".Rhistory",
  ".Rdata",
  ".httr-oauth",
  ".DS_Store"
)

Try the usethis package in your browser

Any scripts or data that you put into this service are public.

usethis documentation built on Oct. 17, 2021, 1:06 a.m.