R/github-labels.R

In poissonconsulting/usepois: Automate Poisson Package and Analysis Project Setup

#' Create Poisson GitHub Issue Labels
#' 
#' Deletes all labels that are unrecognized and not associated with an issue.
#' 
#' Recolors if necessary.
#'
#' @inheritParams usethis::use_github_labels
#' @param pkg A flag specifying whether to create labels for a package (default) or an analysis repository.
#' @export
use_github_labels <- function(
  repo_spec = paste0("poissonconsulting/", basename(getwd())), pkg = TRUE, 
  auth_token = usethis::github_token()) {
  chk_s3_class(repo_spec, "character")
  
  gh <- function(endpoint, ...) {
    gh::gh(endpoint, ..., owner = spec_owner(repo_spec), 
           repo = spec_repo(repo_spec), 
           .token = auth_token, 
           .api_url = NULL, 
           .send_headers = c(Accept = "application/vnd.github.symmetra-preview+json"))
  }
  
  if(!vld_match(repo_spec, "^[[:alpha:]][[:alnum:]_-]*/[[:alpha:]][[:alnum:]_-]*$")){
    repo_spec <- paste0("poissonconsulting/", repo_spec)
    resp <- try(gh("GET /repos/:owner/:repo"), silent = TRUE)
    if(inherits(resp, "try-error") | !resp[3] == spec_repo(repo_spec)) abort_chk("Invalid `repo_spec`.")

  } else {
    resp <- try(gh("GET /repos/:owner/:repo"), silent = TRUE)
    if(inherits(resp, "try-error") | !resp[3] == spec_repo(repo_spec)) abort_chk("Invalid `repo_spec`.")
  } 
  
  chk_flag(pkg)
  repo_labels <- if(pkg) .pkg_labels else .analysis_labels
  
  cur_labels <- gh("GET /repos/:owner/:repo/labels")
  cur_labels <- purrr::set_names(label_attr("color", cur_labels), 
                          label_attr("name", cur_labels))

  for (label in names(cur_labels)) {
    if(!label %in% names(repo_labels)) {
      if(!length(gh("GET /repos/:owner/:repo/issues", 
                    labels = label))) {
        gh("DELETE /repos/:owner/:repo/labels/:name", 
           name = label)
        ui_done("Removed {ui_value(label)} label")
      } else
        ui_todo("Delete {ui_value(label)} label manually; it has associated issues")
    }
  }
  
  cur_labels <- gh("GET /repos/:owner/:repo/labels")
  cur_labels <- purrr::set_names(label_attr("color", cur_labels), 
                          label_attr("name", cur_labels))
  
  for(label in names(repo_labels)) {
    if(!label %in% names(cur_labels)) {
      gh(
        "POST /repos/:owner/:repo/labels",
        name = label,
        color = repo_labels[label]
      )
        ui_done("Added {ui_value(label)} label")
    } else {
      if(!identical(cur_labels[label], repo_labels[label])) {
        gh("PATCH /repos/:owner/:repo/labels/:name", 
           name = label, 
           color = repo_labels[label])
        ui_done("Recolored {ui_value(label)} label")
      }
    }
  }
  invisible(TRUE)
}


gh <- function(endpoint, ...) {
  gh::gh(endpoint, ..., owner = spec_owner(repo_spec), 
         repo = spec_repo(repo_spec), 
         .token = auth_token, 
         .api_url = NULL, 
         .send_headers = c(Accept = "application/vnd.github.symmetra-preview+json"))
}