1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183
|
#' Helpers for GitHub issues
#'
#' @description
#' The `issue_*` family of functions allows you to perform common operations on
#' GitHub issues from within R. They're designed to help you efficiently deal
#' with large numbers of issues, particularly motivated by the challenges faced
#' by the tidyverse team.
#'
#' * `issue_close_community()` closes an issue, because it's not a bug report or
#' feature request, and points the author towards Posit Community as a
#' better place to discuss usage (<https://forum.posit.co>).
#'
#' * `issue_reprex_needed()` labels the issue with the "reprex" label and
#' gives the author some advice about what is needed.
#'
#' @section Saved replies:
#'
#' Unlike GitHub's "saved replies", these functions can:
#' * Be shared between people
#' * Perform other actions, like labelling, or closing
#' * Have additional arguments
#' * Include randomness (like friendly gifs)
#'
#' @param number Issue number
#' @param reprex Does the issue also need a reprex?
#'
#' @examples
#' \dontrun{
#' issue_close_community(12, reprex = TRUE)
#'
#' issue_reprex_needed(241)
#' }
#' @name issue-this
NULL
#' @export
#' @rdname issue-this
issue_close_community <- function(number, reprex = FALSE) {
tr <- target_repo(github_get = TRUE)
if (!tr$can_push) {
# https://docs.github.com/en/github/setting-up-and-managing-organizations-and-teams/repository-permission-levels-for-an-organization#repository-access-for-each-permission-level
# I have not found a way to detect triage permission via API.
# It seems you just have to try?
ui_bullets(c(
"!" = "You don't seem to have push access for {.val {tr$repo_spec}}.",
"i" = "Unless you have triage permissions, you won't be allowed to close
an issue."
))
if (ui_nah("Do you want to try anyway?")) {
ui_bullets(c("x" = "Cancelling."))
return(invisible())
}
}
info <- issue_info(number, tr)
issue <- issue_details(info)
ui_bullets(c(
"v" = "Closing issue {.val {issue$shorthand}} ({.field {issue$author}}):
{.val {issue$title}}."
))
if (info$state == "closed") {
ui_abort("Issue {.val {number}} is already closed.")
}
reprex_insert <- glue("
But before you ask there, I'd suggest that you create a \\
[reprex](https://reprex.tidyverse.org/articles/reprex-dos-and-donts.htm), \\
because that greatly increases your chances getting help.")
message <- glue(
"Hi {issue$author},\n",
"\n",
"This issue doesn't appear to be a bug report or a specific feature ",
"request, so it's more suitable for ",
"[RStudio Community](https://community.rstudio.com). ",
if (reprex) reprex_insert else "",
"\n\n",
"Thanks!"
)
issue_comment_add(number, message = message, tr = tr)
issue_edit(number, state = "closed", tr = tr)
}
#' @export
#' @rdname issue-this
issue_reprex_needed <- function(number) {
tr <- target_repo(github_get = TRUE)
if (!tr$can_push) {
# https://docs.github.com/en/github/setting-up-and-managing-organizations-and-teams/repository-permission-levels-for-an-organization#repository-access-for-each-permission-level
# I can't find anyway to detect triage permission via API.
# It seems you just have to try?
ui_bullets(c(
"!" = "You don't seem to have push access for {.val {tr$repo_spec}}.",
"i" = "Unless you have triage permissions, you won't be allowed to label
an issue."
))
if (ui_nah("Do you want to try anyway?")) {
ui_bullets(c("x" = "Cancelling."))
return(invisible())
}
}
info <- issue_info(number, tr)
labels <- map_chr(info$labels, "name")
issue <- issue_details(info)
if ("reprex" %in% labels) {
ui_abort("Issue {.val {number}} already has {.val reprex} label.")
}
ui_bullets(c(
"v" = "Labelling and commenting on issue {.val {issue$shorthand}}
({.field {issue$author}}): {.val {issue$title}}."
))
message <- glue("
Can you please provide a minimal reproducible example using the \\
[reprex](http://reprex.tidyverse.org) package?
The goal of a reprex is to make it as easy as possible for me to \\
recreate your problem so that I can fix it.
If you've never made a minimal reprex before, there is lots of good advice \\
[here](https://reprex.tidyverse.org/articles/reprex-dos-and-donts.html).")
issue_comment_add(number, message = message, tr = tr)
issue_edit(number, labels = as.list(union(labels, "reprex")), tr = tr)
}
# low-level operations ----------------------------------------------------
issue_comment_add <- function(number, message, tr = NULL) {
issue_gh(
"POST /repos/{owner}/{repo}/issues/{issue_number}/comments",
number = number,
body = message,
tr = tr
)
}
issue_edit <- function(number, ..., tr = NULL) {
issue_gh(
"PATCH /repos/{owner}/{repo}/issues/{issue_number}",
...,
number = number,
tr = tr
)
}
issue_info <- function(number, tr = NULL) {
issue_gh(
"GET /repos/{owner}/{repo}/issues/{issue_number}",
number = number,
tr = tr
)
}
# Helpers -----------------------------------------------------------------
# Assumptions:
# * Issue number is called `issue_number`; make sure to tweak `endpoint` if
# necessary.
# * The user-facing caller should pass information about the target repo,
# because that is required to vet the GitHub remote config anyway.
# The fallback to target_repo() is purely for development convenience.
issue_gh <- function(endpoint, ..., number, tr = NULL) {
tr <- tr %||% target_repo(github_get = NA)
gh <- gh_tr(tr)
out <- gh(endpoint, ..., issue_number = number)
if (substr(endpoint, 1, 4) == "GET ") {
out
} else {
invisible(out)
}
}
issue_details <- function(info) {
repo_dat <- parse_github_remotes(info$html_url)
list(
shorthand = glue(
"{repo_dat$repo_owner}/{repo_dat$repo_name}/#{info$number}"
),
author = glue("@{info$user$login}"),
title = info$title
)
}
|