|
| 1 | +# See cli manual at https://cli.github.com/manual/ |
| 2 | + |
| 3 | +# This functions tries the gh command in a terminal. If it errors, the gh cli |
| 4 | +# isn't available on the machine or at least not on the PATH variable |
| 5 | +gh_cli_available <- function() { |
| 6 | + gh_test <- try(system("gh", intern = TRUE), silent = TRUE) |
| 7 | + |
| 8 | + if (inherits(gh_test, "try-error")) { |
| 9 | + cli::cli_abort( |
| 10 | + "The Github Command Line Interface is not available on your machine! \\ |
| 11 | + Please visit {.url https://github.com/cli/cli#installation} \\ |
| 12 | + for install instructions." |
| 13 | + ) |
| 14 | + } |
| 15 | + |
| 16 | + invisible(TRUE) |
| 17 | +} |
| 18 | + |
| 19 | +gh_cli_release_upload <- function( |
| 20 | + files, |
| 21 | + tag, |
| 22 | + ..., |
| 23 | + repo = "ffverse/ffopportunity", |
| 24 | + overwrite = TRUE |
| 25 | +) { |
| 26 | + # see https://cli.github.com/manual/gh_release_upload |
| 27 | + |
| 28 | + # validate file paths |
| 29 | + file_available <- file.exists(files) |
| 30 | + |
| 31 | + # if files are missing, warn the user and update the files vector to keep |
| 32 | + # valid file paths only. If there are no valid file paths, exit the function. |
| 33 | + if (!all(file_available)) { |
| 34 | + cli::cli_alert_warning( |
| 35 | + "The following file{?s} {?is/are} missing: {.path {files[!file_available]}}" |
| 36 | + ) |
| 37 | + |
| 38 | + if (all(file_available == FALSE)) { |
| 39 | + cli::cli_alert_warning("There's nothing left to upload. Exiting!") |
| 40 | + return(invisible(FALSE)) |
| 41 | + } |
| 42 | + } |
| 43 | + # keep valid file paths |
| 44 | + files <- files[file_available] |
| 45 | + |
| 46 | + # Make sure the gh cli is available |
| 47 | + gh_cli_available() |
| 48 | + |
| 49 | + # create command for the shell |
| 50 | + cli_command <- paste( |
| 51 | + "gh release upload", |
| 52 | + tag, |
| 53 | + paste(files, collapse = " "), |
| 54 | + "-R", |
| 55 | + repo, |
| 56 | + if (isTRUE(overwrite)) "--clobber" else "" |
| 57 | + ) |
| 58 | + |
| 59 | + cli::cli_alert_info( |
| 60 | + "Start upload of {cli::no(length(files))} file{?s} to \\ |
| 61 | + {.url {paste0('https://github.com/', repo, '/releases')}} \\ |
| 62 | + @ {.field {tag}}", |
| 63 | + wrap = TRUE |
| 64 | + ) |
| 65 | + |
| 66 | + cli_output <- .invoke_cli_command(cli_command = cli_command) |
| 67 | + |
| 68 | + cli::cli_alert_success("Upload successfully completed.") |
| 69 | + |
| 70 | + invisible(TRUE) |
| 71 | +} |
| 72 | + |
| 73 | +gh_cli_release_tags <- function(repo = "ffverse/ffopportunity") { |
| 74 | + # see https://cli.github.com/manual/gh_release_list |
| 75 | + |
| 76 | + # Make sure the gh cli is available |
| 77 | + gh_cli_available() |
| 78 | + |
| 79 | + # create command for the shell |
| 80 | + cli_command <- paste( |
| 81 | + "gh release list", |
| 82 | + "-R", |
| 83 | + repo, |
| 84 | + "--json tagName" |
| 85 | + ) |
| 86 | + |
| 87 | + cli_output <- .invoke_cli_command(cli_command = cli_command) |
| 88 | + |
| 89 | + .cli_parse_json(cli_output = cli_output)[["tagName"]] |
| 90 | +} |
| 91 | + |
| 92 | +gh_cli_release_assets <- function(tag, ..., repo = "ffverse/ffopportunity") { |
| 93 | + # see https://cli.github.com/manual/gh_release_view |
| 94 | + |
| 95 | + # Make sure the gh cli is available |
| 96 | + gh_cli_available() |
| 97 | + |
| 98 | + # create command for the shell |
| 99 | + cli_command <- paste( |
| 100 | + "gh release view", |
| 101 | + tag, |
| 102 | + "-R", |
| 103 | + repo, |
| 104 | + "--json assets" |
| 105 | + ) |
| 106 | + |
| 107 | + cli_output <- .invoke_cli_command(cli_command = cli_command) |
| 108 | + |
| 109 | + out <- .cli_parse_json(cli_output = cli_output)[["assets"]] |
| 110 | + |
| 111 | + setDT(out) |
| 112 | + ret <- out[, |
| 113 | + list(name, size, downloads = downloadCount, last_update = updatedAt, url) |
| 114 | + ][, size_string := as.character(rlang::as_bytes(size))][ |
| 115 | + !grepl("timestamp", name) |
| 116 | + ] |
| 117 | + setDF(ret) |
| 118 | + ret |
| 119 | +} |
| 120 | + |
| 121 | +.invoke_cli_command <- function(cli_command) { |
| 122 | + # This command will error regularly on R error and also errors on warnings |
| 123 | + # because some failures raise a warning only and we want workflows to fail |
| 124 | + # if somethings didn't work |
| 125 | + out <- purrr::quietly(system)(cli_command, intern = TRUE) |
| 126 | + if (length(out$warnings)) { |
| 127 | + cli::cli_abort( |
| 128 | + "The GitHub cli errored with the following message: {.val {out$result}}. \\ |
| 129 | + Here is the R message: {.val {out$warnings}}", |
| 130 | + call = NULL |
| 131 | + ) |
| 132 | + } |
| 133 | + out$result |
| 134 | +} |
| 135 | + |
| 136 | +.cli_parse_json <- function(cli_output) { |
| 137 | + # regex shamelessly stolen from crayon::strip_style |
| 138 | + ansi_regex <- "(?:(?:\\x{001b}\\[)|\\x{009b})(?:(?:[0-9]{1,3})?(?:(?:;[0-9]{0,3})*)?[A-M|f-m])|\\x{001b}[A-M]" |
| 139 | + gsub(ansi_regex, "", cli_output, perl = TRUE, useBytes = TRUE) |> |
| 140 | + paste0(collapse = "") |> |
| 141 | + jsonlite::parse_json(simplifyVector = TRUE) |
| 142 | +} |
0 commit comments