1#' Find the GitHub remote associated with a path
2#'
3#' This is handy helper if you want to make gh requests related to the
4#' current project.
5#'
6#' @param path Path that is contained within a git repo.
7#' @return If the repo has a github remote, a list containing `username`
8#'    and `repo`. Otherwise, an error.
9#' @export
10#' @examplesIf interactive()
11#' gh_tree_remote()
12
13gh_tree_remote <- function(path = ".") {
14  github_remote(git_remotes(path))
15}
16
17github_remote <- function(x) {
18  remotes <- lapply(x, github_remote_parse)
19  remotes <- remotes[!vapply(remotes, is.null, logical(1))]
20
21  if (length(remotes) == 0) {
22    throw(new_error("No github remotes found", call. = FALSE))
23  }
24
25  if (length(remotes) > 1) {
26    if (any(names(remotes) == "origin")) {
27      warning("Multiple github remotes found. Using origin.", call. = FALSE)
28      remotes <- remotes[["origin"]]
29    } else {
30      warning("Multiple github remotes found. Using first.", call. = FALSE)
31      remotes <- remotes[[1]]
32    }
33  } else {
34    remotes[[1]]
35  }
36}
37
38github_remote_parse <- function(x) {
39  if (length(x) == 0) return(NULL)
40  if (!grepl("github", x)) return(NULL)
41
42  # https://github.com/hadley/devtools.git
43  # https://github.com/hadley/devtools
44  # git@github.com:hadley/devtools.git
45  re <- "github[^/:]*[/:]([^/]+)/(.*?)(?:\\.git)?$"
46  m <- regexec(re, x)
47  match <- regmatches(x, m)[[1]]
48
49  if (length(match) == 0)
50    return(NULL)
51
52  list(
53    username = match[2],
54    repo = match[3]
55  )
56}
57
58git_remotes <- function(path = ".") {
59  conf <- git_config(path)
60  remotes <- conf[grepl("^remote", names(conf))]
61
62  remotes <- discard(remotes, function(x) is.null(x$url))
63  urls <- vapply(remotes, "[[", "url", FUN.VALUE = character(1))
64
65  names(urls) <- gsub('^remote "(.*?)"$', "\\1", names(remotes))
66  urls
67}
68
69
70
71git_config <- function(path = ".") {
72  config_path <- file.path(repo_root(path), ".git", "config")
73  if (!file.exists(config_path)) {
74    throw(new_error("git config does not exist", call. = FALSE))
75
76  }
77  ini::read.ini(config_path, "UTF-8")
78}
79
80repo_root <- function(path = ".") {
81  if (!file.exists(path)) {
82    throw(new_error("Can't find '", path, "'.", call. = FALSE))
83  }
84
85  # Walk up to root directory
86  while (!has_git(path)) {
87    if (is_root(path)) {
88      throw(new_error("Could not find git root.", call. = FALSE))
89    }
90
91    path <- dirname(path)
92  }
93
94  path
95}
96
97has_git <- function(path) {
98  file.exists(file.path(path, ".git"))
99}
100
101is_root <- function(path) {
102  identical(path, dirname(path))
103}
104