├── .Rbuildignore ├── .github ├── .gitignore ├── CODE_OF_CONDUCT.md └── workflows │ ├── R-CMD-check.yaml │ └── rhub.yaml ├── .gitignore ├── DESCRIPTION ├── LICENSE ├── LICENSE.md ├── Makefile ├── NAMESPACE ├── NEWS.md ├── R ├── a-rstudio-detect.R ├── aa-assertthat.R ├── aaa-async.R ├── assertions.R ├── assertthat.R ├── check.R ├── cli.R ├── compat-vctrs.R ├── doctor.R ├── errors.R ├── gh.R ├── http-cache.R ├── platforms.R ├── rematch.R ├── setup.R └── utils.R ├── README.Rmd ├── README.md ├── actions ├── rhub-check │ └── action.yaml ├── rhub-checkout │ └── action.yaml ├── rhub-platform-info │ └── action.yaml ├── rhub-run-check │ └── action.yaml ├── rhub-setup-deps │ └── action.yaml ├── rhub-setup-r │ ├── action.yaml │ └── set-rhub-repos.R └── rhub-setup │ ├── Makefile │ ├── _snaps │ └── platforms.md │ ├── action.yaml │ ├── json.R │ ├── platforms.R │ └── platforms.json ├── inst ├── header.md └── workflow │ └── rhub.yaml ├── man ├── figures │ ├── rhub-check-dark.svg │ ├── rhub-check.svg │ ├── rhub-doctor-dark.svg │ ├── rhub-doctor.svg │ ├── rhub-platforms-dark.svg │ ├── rhub-platforms.svg │ ├── rhub-setup-dark.svg │ └── rhub-setup.svg ├── rhub_check.Rd ├── rhub_doctor.Rd ├── rhub_platforms.Rd └── rhub_setup.Rd └── tests ├── testthat.R └── testthat ├── _snaps └── gh.md └── test-gh.R /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^LICENSE\.md$ 2 | ^\.github$ 3 | ^actions$ 4 | ^Makefile$ 5 | ^README\.Rmd$ 6 | ^README[.]html$ 7 | ^rhub2\.Rproj$ 8 | ^\.Rproj\.user$ 9 | -------------------------------------------------------------------------------- /.github/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | -------------------------------------------------------------------------------- /.github/CODE_OF_CONDUCT.md: -------------------------------------------------------------------------------- 1 | # Contributor Covenant Code of Conduct 2 | 3 | ## Our Pledge 4 | 5 | We as members, contributors, and leaders pledge to make participation in our 6 | community a harassment-free experience for everyone, regardless of age, body 7 | size, visible or invisible disability, ethnicity, sex characteristics, gender 8 | identity and expression, level of experience, education, socio-economic status, 9 | nationality, personal appearance, race, caste, color, religion, or sexual 10 | identity and orientation. 11 | 12 | We pledge to act and interact in ways that contribute to an open, welcoming, 13 | diverse, inclusive, and healthy community. 14 | 15 | ## Our Standards 16 | 17 | Examples of behavior that contributes to a positive environment for our 18 | community include: 19 | 20 | * Demonstrating empathy and kindness toward other people 21 | * Being respectful of differing opinions, viewpoints, and experiences 22 | * Giving and gracefully accepting constructive feedback 23 | * Accepting responsibility and apologizing to those affected by our mistakes, 24 | and learning from the experience 25 | * Focusing on what is best not just for us as individuals, but for the overall 26 | community 27 | 28 | Examples of unacceptable behavior include: 29 | 30 | * The use of sexualized language or imagery, and sexual attention or advances of 31 | any kind 32 | * Trolling, insulting or derogatory comments, and personal or political attacks 33 | * Public or private harassment 34 | * Publishing others' private information, such as a physical or email address, 35 | without their explicit permission 36 | * Other conduct which could reasonably be considered inappropriate in a 37 | professional setting 38 | 39 | ## Enforcement Responsibilities 40 | 41 | Community leaders are responsible for clarifying and enforcing our standards of 42 | acceptable behavior and will take appropriate and fair corrective action in 43 | response to any behavior that they deem inappropriate, threatening, offensive, 44 | or harmful. 45 | 46 | Community leaders have the right and responsibility to remove, edit, or reject 47 | comments, commits, code, wiki edits, issues, and other contributions that are 48 | not aligned to this Code of Conduct, and will communicate reasons for moderation 49 | decisions when appropriate. 50 | 51 | ## Scope 52 | 53 | This Code of Conduct applies within all community spaces, and also applies when 54 | an individual is officially representing the community in public spaces. 55 | Examples of representing our community include using an official e-mail address, 56 | posting via an official social media account, or acting as an appointed 57 | representative at an online or offline event. 58 | 59 | ## Enforcement 60 | 61 | Instances of abusive, harassing, or otherwise unacceptable behavior may be 62 | reported to the community leaders responsible for enforcement at codeofconduct@rstudio.com. 63 | All complaints will be reviewed and investigated promptly and fairly. 64 | 65 | All community leaders are obligated to respect the privacy and security of the 66 | reporter of any incident. 67 | 68 | ## Enforcement Guidelines 69 | 70 | Community leaders will follow these Community Impact Guidelines in determining 71 | the consequences for any action they deem in violation of this Code of Conduct: 72 | 73 | ### 1. Correction 74 | 75 | **Community Impact**: Use of inappropriate language or other behavior deemed 76 | unprofessional or unwelcome in the community. 77 | 78 | **Consequence**: A private, written warning from community leaders, providing 79 | clarity around the nature of the violation and an explanation of why the 80 | behavior was inappropriate. A public apology may be requested. 81 | 82 | ### 2. Warning 83 | 84 | **Community Impact**: A violation through a single incident or series of 85 | actions. 86 | 87 | **Consequence**: A warning with consequences for continued behavior. No 88 | interaction with the people involved, including unsolicited interaction with 89 | those enforcing the Code of Conduct, for a specified period of time. This 90 | includes avoiding interactions in community spaces as well as external channels 91 | like social media. Violating these terms may lead to a temporary or permanent 92 | ban. 93 | 94 | ### 3. Temporary Ban 95 | 96 | **Community Impact**: A serious violation of community standards, including 97 | sustained inappropriate behavior. 98 | 99 | **Consequence**: A temporary ban from any sort of interaction or public 100 | communication with the community for a specified period of time. No public or 101 | private interaction with the people involved, including unsolicited interaction 102 | with those enforcing the Code of Conduct, is allowed during this period. 103 | Violating these terms may lead to a permanent ban. 104 | 105 | ### 4. Permanent Ban 106 | 107 | **Community Impact**: Demonstrating a pattern of violation of community 108 | standards, including sustained inappropriate behavior, harassment of an 109 | individual, or aggression toward or disparagement of classes of individuals. 110 | 111 | **Consequence**: A permanent ban from any sort of public interaction within the 112 | community. 113 | 114 | ## Attribution 115 | 116 | This Code of Conduct is adapted from the [Contributor Covenant][homepage], 117 | version 2.1, available at 118 | . 119 | 120 | Community Impact Guidelines were inspired by 121 | [Mozilla's code of conduct enforcement ladder][https://github.com/mozilla/inclusion]. 122 | 123 | For answers to common questions about this code of conduct, see the FAQ at 124 | . Translations are available at . 125 | 126 | [homepage]: https://www.contributor-covenant.org 127 | -------------------------------------------------------------------------------- /.github/workflows/R-CMD-check.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | pull_request: 7 | branches: [main, master] 8 | 9 | name: R-CMD-check 10 | 11 | jobs: 12 | R-CMD-check: 13 | runs-on: ubuntu-latest 14 | env: 15 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 16 | R_KEEP_PKG_SOURCE: yes 17 | steps: 18 | - uses: actions/checkout@v4 19 | 20 | - uses: r-lib/actions/setup-r@v2 21 | with: 22 | use-public-rspm: true 23 | 24 | - uses: r-lib/actions/setup-r-dependencies@v2 25 | with: 26 | extra-packages: any::rcmdcheck 27 | needs: check 28 | 29 | - uses: r-lib/actions/check-r-package@v2 30 | -------------------------------------------------------------------------------- /.github/workflows/rhub.yaml: -------------------------------------------------------------------------------- 1 | # R-hub's generic GitHub Actions workflow file. It's canonical location is at 2 | # https://github.com/r-hub/rhub2/blob/v1/inst/workflow/rhub.yaml 3 | # You can update this file to a newer version using the rhub2 package: 4 | # 5 | # rhub2::rhub_setup() 6 | # 7 | # It is unlikely that you need to modify this file manually. 8 | 9 | name: R-hub 10 | run-name: ${{ github.event.inputs.name || format('Manually run by {0}', github.triggering_actor) }} (${{ github.event.inputs.id }}) 11 | 12 | on: 13 | workflow_dispatch: 14 | inputs: 15 | config: 16 | description: 'A comma separated list of R-hub platforms to use.' 17 | type: string 18 | default: 'linux,windows,macos' 19 | name: 20 | description: 'Run name. You can leave this empty now.' 21 | type: string 22 | id: 23 | description: 'Unique ID. You can leave this empty now.' 24 | type: string 25 | 26 | jobs: 27 | 28 | setup: 29 | runs-on: ubuntu-latest 30 | outputs: 31 | containers: ${{ steps.rhub-setup.outputs.containers }} 32 | platforms: ${{ steps.rhub-setup.outputs.platforms }} 33 | 34 | steps: 35 | - uses: actions/checkout@v4 36 | - uses: ./actions/rhub-setup 37 | with: 38 | config: ${{ github.event.inputs.config }} 39 | id: rhub-setup 40 | 41 | linux-containers: 42 | needs: setup 43 | if: ${{ needs.setup.outputs.containers != '[]' }} 44 | runs-on: ubuntu-latest 45 | name: ${{ matrix.config.label }} 46 | strategy: 47 | fail-fast: false 48 | matrix: 49 | config: ${{ fromJson(needs.setup.outputs.containers) }} 50 | container: 51 | image: ${{ matrix.config.container }} 52 | 53 | steps: 54 | - uses: actions/checkout@v4 55 | - uses: ./actions/rhub-check 56 | with: 57 | token: ${{ secrets.RHUB_TOKEN }} 58 | job-config: ${{ matrix.config.job-config }} 59 | 60 | other-platforms: 61 | needs: setup 62 | if: ${{ needs.setup.outputs.platforms != '[]' }} 63 | runs-on: ${{ matrix.config.os }} 64 | name: ${{ matrix.config.label }} 65 | strategy: 66 | fail-fast: false 67 | matrix: 68 | config: ${{ fromJson(needs.setup.outputs.platforms) }} 69 | 70 | steps: 71 | - uses: actions/checkout@v4 72 | - uses: ./actions/rhub-setup-r 73 | with: 74 | job-config: ${{ matrix.config.job-config }} 75 | token: ${{ secrets.RHUB_TOKEN }} 76 | - uses: ./actions/rhub-check 77 | with: 78 | job-config: ${{ matrix.config.job-config }} 79 | token: ${{ secrets.RHUB_TOKEN }} 80 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .Rdata 4 | .httr-oauth 5 | .DS_Store 6 | /README.html 7 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: rhub2 2 | Title: The 'R-hub' package builder, version 2 3 | Version: 0.0.0.9000 4 | Authors@R: 5 | person("Gábor", "Csárdi", , "csardi.gabor@gmail.com", role = c("aut", "cre")) 6 | Description: 'R-hub' 2 uses 'GitHub' Actions to run 'R CMD check' and 7 | similar package checks. The 'rhub2' package helps you set up 'R-hub' 2 8 | for your R package, and start package checks. 9 | License: MIT + file LICENSE 10 | Encoding: UTF-8 11 | Roxygen: list(markdown = TRUE) 12 | RoxygenNote: 7.2.3 13 | Imports: 14 | callr, 15 | cli, 16 | curl, 17 | gert, 18 | glue, 19 | gitcreds, 20 | jsonlite, 21 | processx, 22 | R6, 23 | rprojroot 24 | Suggests: 25 | asciicast, 26 | debugme, 27 | pillar, 28 | testthat (>= 3.0.0) 29 | Config/testthat/edition: 3 30 | URL: https://github.com/r-hub/rhub2 31 | BugReports: https://github.com/r-hub/rhub2/issues 32 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2023 2 | COPYRIGHT HOLDER: rhub2 authors 3 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | # MIT License 2 | 3 | Copyright (c) 2023 rhub2 authors 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | WORKFLOWS := .github/workflows/rhub.yaml 2 | 3 | all : $(WORKFLOWS) 4 | 5 | $(WORKFLOWS) : .github/workflows/%.yaml: inst/workflow/%.yaml 6 | perl -pe 's{r-hub/rhub2/actions/([\w-]+)\@v1}{./actions/$$1}g' $^ | \ 7 | perl -pe 's{# NO NEED TO CHECKOUT HERE}{- uses: actions/checkout\@v4}g' > $@ 8 | 9 | .PHONY: clean 10 | clean: 11 | rm -f $(WORKFLOWS) 12 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method("[",rhub2_platforms) 4 | S3method(format,rhub2_platforms) 5 | S3method(format,rhub2_platforms_summary) 6 | S3method(print,rhub2_platforms) 7 | S3method(print,rhub2_platforms_summary) 8 | S3method(summary,rhub2_platforms) 9 | export(rhub_check) 10 | export(rhub_doctor) 11 | export(rhub_platforms) 12 | export(rhub_setup) 13 | importFrom(R6,R6Class) 14 | importFrom(callr,r_process) 15 | importFrom(callr,r_process_options) 16 | importFrom(callr,r_session) 17 | importFrom(callr,rcmd_safe_env) 18 | importFrom(curl,handle_data) 19 | importFrom(curl,handle_setheaders) 20 | importFrom(curl,handle_setopt) 21 | importFrom(curl,multi_add) 22 | importFrom(curl,multi_cancel) 23 | importFrom(curl,multi_fdset) 24 | importFrom(curl,multi_list) 25 | importFrom(curl,multi_run) 26 | importFrom(curl,multi_set) 27 | importFrom(curl,new_handle) 28 | importFrom(curl,new_pool) 29 | importFrom(curl,parse_headers_list) 30 | importFrom(processx,conn_get_fileno) 31 | importFrom(processx,process) 32 | importFrom(utils,getSrcDirectory) 33 | importFrom(utils,getSrcFilename) 34 | importFrom(utils,getSrcLocation) 35 | importFrom(utils,head) 36 | importFrom(utils,modifyList) 37 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # rhub2 0.0.0.9000 2 | 3 | * First CRAN release. 4 | -------------------------------------------------------------------------------- /R/a-rstudio-detect.R: -------------------------------------------------------------------------------- 1 | 2 | rstudio <- local({ 3 | 4 | standalone_env <- environment() 5 | parent.env(standalone_env) <- baseenv() 6 | 7 | # -- Collect data ------------------------------------------------------ 8 | 9 | data <- NULL 10 | 11 | get_data <- function() { 12 | envs <- c( 13 | "R_BROWSER", 14 | "R_PDFVIEWER", 15 | "RSTUDIO", 16 | "RSTUDIO_TERM", 17 | "RSTUDIO_CONSOLE_COLOR", 18 | "ASCIICAST") 19 | 20 | d <- list( 21 | pid = Sys.getpid(), 22 | envs = Sys.getenv(envs), 23 | api = tryCatch( 24 | asNamespace("rstudioapi")$isAvailable(), 25 | error = function(err) FALSE 26 | ), 27 | tty = isatty(stdin()), 28 | gui = .Platform$GUI, 29 | args = commandArgs(), 30 | search = search() 31 | ) 32 | d$ver <- if (d$api) asNamespace("rstudioapi")$getVersion() 33 | d$desktop <- if (d$api) asNamespace("rstudioapi")$versionInfo()$mode 34 | 35 | d 36 | } 37 | 38 | # -- Auto-detect environment ------------------------------------------- 39 | 40 | is_rstudio <- function() { 41 | Sys.getenv("RSTUDIO") == "1" 42 | } 43 | 44 | detect <- function(clear_cache = FALSE) { 45 | # Cached? 46 | if (clear_cache) data <<- list() 47 | if (!is.null(data)) return(get_caps(data)) 48 | 49 | # Otherwise get data 50 | new <- get_data() 51 | 52 | # Cache unless told otherwise 53 | cache <- TRUE 54 | 55 | new$type <- if (new$envs[["RSTUDIO"]] != "1") { 56 | # 1. Not RStudio at all 57 | "not_rstudio" 58 | 59 | } else if (new$gui == "RStudio" && new$api) { 60 | # 2. RStudio console, properly initialized 61 | "rstudio_console" 62 | 63 | } else if (new$gui == "RStudio" && ! new$api) { 64 | # 3. RStudio console, initilizing 65 | cache <- FALSE 66 | "rstudio_console_starting" 67 | 68 | } else if (new$tty && new$envs[["ASCIICAST"]] != "true") { 69 | # 4. R in the RStudio terminal 70 | # This could also be a subprocess of the console or build pane 71 | # with a pseudo-terminal. There isn't really a way to rule that 72 | # out, without inspecting some process data with ps::ps_*(). 73 | # At least we rule out asciicast 74 | "rstudio_terminal" 75 | 76 | } else if (! new$tty && 77 | new$envs[["RSTUDIO_TERM"]] == "" && 78 | new$envs[["R_BROWSER"]] == "false" && 79 | new$envs[["R_PDFVIEWER"]] == "false" && 80 | is_build_pane_command(new$args)) { 81 | # 5. R in the RStudio build pane 82 | # https://github.com/rstudio/rstudio/blob/master/src/cpp/session/ 83 | # modules/build/SessionBuild.cpp#L231-L240 84 | "rstudio_build_pane" 85 | 86 | } else { 87 | # Otherwise it is a subprocess of the console, terminal or 88 | # build pane, and it is hard to say which, so we do not try. 89 | "rstudio_subprocess" 90 | } 91 | 92 | if (cache) data <<- new 93 | 94 | get_caps(new) 95 | } 96 | 97 | is_build_pane_command <- function(args) { 98 | cmd <- gsub("[\"']", "", args[[length(args)]]) 99 | rcmd <- sub("[(].*$", "", cmd) 100 | rcmd %in% c("devtools::build", "devtools::test", "devtools::check") 101 | } 102 | 103 | # -- Capabilities ------------------------------------------------------ 104 | 105 | caps <- list() 106 | 107 | caps$not_rstudio <- function(data) { 108 | list( 109 | type = "not_rstudio", 110 | dynamic_tty = FALSE, 111 | ansi_tty = FALSE, 112 | ansi_color = FALSE, 113 | num_colors = 1L 114 | ) 115 | } 116 | 117 | caps$rstudio_console <- function(data) { 118 | list( 119 | type = "rstudio_console", 120 | dynamic_tty = TRUE, 121 | ansi_tty = FALSE, 122 | ansi_color = data$envs[["RSTUDIO_CONSOLE_COLOR"]] != "", 123 | num_colors = as.integer(data$envs[["RSTUDIO_CONSOLE_COLOR"]]) 124 | ) 125 | } 126 | 127 | caps$rstudio_console_starting <- function(data) { 128 | res <- caps$rstudio_console(data) 129 | res$type <- "rstudio_console_starting" 130 | res 131 | } 132 | 133 | caps$rstudio_terminal <- function(data) { 134 | list( 135 | type = "rstudio_terminal", 136 | dynamic_tty = TRUE, 137 | ansi_tty = TRUE, 138 | ansi_color = data$envs[["RSTUDIO_CONSOLE_COLOR"]] != "", 139 | num_colors = as.integer(data$envs[["RSTUDIO_CONSOLE_COLOR"]]) 140 | ) 141 | } 142 | 143 | caps$rstudio_build_pane <- function(data) { 144 | list( 145 | type = "rstudio_build_pane", 146 | dynamic_tty = TRUE, 147 | ansi_tty = FALSE, 148 | ansi_color = data$envs[["RSTUDIO_CONSOLE_COLOR"]] != "", 149 | num_colors = as.integer(data$envs[["RSTUDIO_CONSOLE_COLOR"]]) 150 | ) 151 | } 152 | 153 | caps$rstudio_subprocess <- function(data) { 154 | list( 155 | type = "rstudio_subprocess", 156 | dynamic_tty = FALSE, 157 | ansi_tty = FALSE, 158 | ansi_color = FALSE, 159 | num_colors = 1L 160 | ) 161 | } 162 | 163 | get_caps <- function(data, type = data$type) { 164 | ret <- caps[[type]](data) 165 | ret$version <- data$ver 166 | ret 167 | } 168 | 169 | structure( 170 | list( 171 | .internal = standalone_env, 172 | is_rstudio = is_rstudio, 173 | detect = detect 174 | ), 175 | class = c("standalone_rstudio_detect", "standalone") 176 | ) 177 | }) 178 | -------------------------------------------------------------------------------- /R/aa-assertthat.R: -------------------------------------------------------------------------------- 1 | 2 | assert_that <- function(..., env = parent.frame(), msg = NULL) { 3 | res <- see_if(..., env = env, msg = msg) 4 | if (res) return(TRUE) 5 | 6 | throw(new_assert_error(attr(res, "msg"))) 7 | } 8 | 9 | new_assert_error <- function (message, call = NULL) { 10 | cond <- new_error(message, call. = call) 11 | class(cond) <- c("assert_error", class(cond)) 12 | cond 13 | } 14 | 15 | see_if <- function(..., env = parent.frame(), msg = NULL) { 16 | asserts <- eval(substitute(alist(...))) 17 | 18 | for (assertion in asserts) { 19 | res <- tryCatch({ 20 | eval(assertion, env) 21 | }, error = function(e) { 22 | structure(FALSE, msg = e$message) 23 | }) 24 | check_result(res) 25 | 26 | # Failed, so figure out message to produce 27 | if (!res) { 28 | if (is.null(msg)) 29 | msg <- get_message(res, assertion, env) 30 | return(structure(FALSE, msg = msg)) 31 | } 32 | } 33 | 34 | res 35 | } 36 | 37 | check_result <- function(x) { 38 | if (!is.logical(x)) 39 | throw(new_assert_error("assert_that: assertion must return a logical value")) 40 | if (any(is.na(x))) 41 | throw(new_assert_error("assert_that: missing values present in assertion")) 42 | if (length(x) != 1) { 43 | throw(new_assert_error("assert_that: length of assertion is not 1")) 44 | } 45 | 46 | TRUE 47 | } 48 | 49 | get_message <- function(res, call, env = parent.frame()) { 50 | stopifnot(is.call(call), length(call) >= 1) 51 | 52 | if (has_attr(res, "msg")) { 53 | return(attr(res, "msg")) 54 | } 55 | 56 | f <- eval(call[[1]], env) 57 | if (!is.primitive(f)) call <- match.call(f, call) 58 | fname <- deparse(call[[1]]) 59 | 60 | fail <- on_failure(f) %||% base_fs[[fname]] %||% fail_default 61 | fail(call, env) 62 | } 63 | 64 | # The default failure message works in the same way as stopifnot, so you can 65 | # continue to use any function that returns a logical value: you just won't 66 | # get a friendly error message. 67 | # The code below says you get the first 60 characters plus a ... 68 | fail_default <- function(call, env) { 69 | call_string <- deparse(call, width.cutoff = 60L) 70 | if (length(call_string) > 1L) { 71 | call_string <- paste0(call_string[1L], "...") 72 | } 73 | 74 | paste0(call_string, " is not TRUE") 75 | } 76 | 77 | on_failure <- function(x) attr(x, "fail") 78 | 79 | "on_failure<-" <- function(x, value) { 80 | stopifnot(is.function(x), identical(names(formals(value)), c("call", "env"))) 81 | attr(x, "fail") <- value 82 | x 83 | } 84 | 85 | has_attr <- function(x, which) !is.null(attr(x, which, exact = TRUE)) 86 | on_failure(has_attr) <- function(call, env) { 87 | paste0(deparse(call$x), " does not have attribute ", eval(call$which, env)) 88 | } 89 | "%has_attr%" <- has_attr 90 | 91 | base_fs <- new.env(parent = emptyenv()) 92 | -------------------------------------------------------------------------------- /R/assertions.R: -------------------------------------------------------------------------------- 1 | 2 | is_character <- function(x) { 3 | if (!is.character(x)) { 4 | structure( 5 | FALSE, 6 | msg = "{.arg {(.arg)}} must be a character vector without {.code NA}, 7 | but it is {.type {x}}", 8 | env = environment() 9 | ) 10 | } else if (anyNA(x)) { 11 | structure( 12 | FALSE, 13 | msg = "{.arg {(.arg)}} must be a character vector without {.code NA}, 14 | but it has {sum(is.na(x))} {.code NA} value{?s}.", 15 | env = environment() 16 | ) 17 | } else { 18 | TRUE 19 | } 20 | } 21 | 22 | is_string <- function(x) { 23 | if (is.character(x) && length(x) == 1 && !is.na(x)) return(TRUE) 24 | if (is.character(x) && length(x) == 1 && is.na(x)) { 25 | structure( 26 | FALSE, 27 | msg = "{.arg {(.arg)}} must not be {.code NA}.", 28 | env = environment() 29 | ) 30 | } else { 31 | structure( 32 | FALSE, 33 | msg = "{.arg {(.arg)}} must be a string (character scalar), 34 | but it is {.type {x}}.", 35 | env = environment() 36 | ) 37 | } 38 | } 39 | 40 | is_optional_string <- function(x) { 41 | if (is.null(x) || is_string(x)) return(TRUE) 42 | structure( 43 | FALSE, 44 | msg = "{.arg {(.arg)}} must be a path (character scalar), 45 | but it is {.type {x}}.", 46 | env = environment() 47 | ) 48 | } 49 | 50 | is_optional_gh_url <- function(x) { 51 | if (is.null(x)) return(TRUE) 52 | 53 | if (!is_string(x)) { 54 | structure( 55 | FALSE, 56 | msg = "{.arg gh_url} must be a character string. 57 | You supplied {.type {x}}." 58 | ) 59 | } else if (!grepl("^https?://", x)) { 60 | structure( 61 | FALSE, 62 | msg = "{.arg gh_url} must be an HTTP or HTTPS URL. 63 | You supplied: {.val {x}}." 64 | ) 65 | } else { 66 | TRUE 67 | } 68 | } 69 | -------------------------------------------------------------------------------- /R/assertthat.R: -------------------------------------------------------------------------------- 1 | 2 | assert_that <- function(..., env = parent.frame(), msg = NULL) { 3 | asserts <- eval(substitute(alist(...))) 4 | 5 | for (assertion in asserts) { 6 | res <- tryCatch({ 7 | eval(assertion, env) 8 | }, assertError = function(e) { 9 | structure(FALSE, msg = e$message) 10 | }) 11 | check_result(res) 12 | if (res) next 13 | 14 | if (is.null(msg)) { 15 | msg <- get_message(res, assertion, env) 16 | evalenv <- attr(res, "env") %||% env 17 | } else { 18 | evalenv <- env 19 | } 20 | throw(assert_error( 21 | assertion, 22 | res, 23 | msg, 24 | call. = sys.call(-1), 25 | .envir = evalenv, 26 | ), frame = env) 27 | } 28 | 29 | invisible(TRUE) 30 | } 31 | 32 | assert_error <- function(assertion, result, msg, .data = NULL, .class = NULL, 33 | .envir = parent.frame(), call. = TRUE) { 34 | 35 | myenv <- new.env(parent = .envir) 36 | myenv$.arg <- if (length(assertion) >= 2) deparse(assertion[[2]]) 37 | myenv$.arg2 <- if (length(assertion) >= 3) deparse(assertion[[3]]) 38 | .hide_from_trace <- TRUE 39 | cnd <- new_error( 40 | call. = call., 41 | cli::format_error( 42 | .envir = myenv, 43 | msg 44 | ) 45 | ) 46 | 47 | if (length(.data)) cnd[names(.data)] <- .data 48 | if (length(class)) class(cnd) <- unique(c(.class, "assertError", class(cnd))) 49 | 50 | cnd 51 | } 52 | check_result <- function(x) { 53 | if (!is.logical(x)) { 54 | throw(pkg_error( 55 | "{.fun assert_that}: assertion must return a logical value.", 56 | "i" = "it returned {.type {x}} instead." 57 | )) 58 | } 59 | 60 | if (length(x) != 1) { 61 | throw(pkg_error( 62 | "{.fun assert_that}: assertion must return a scalar.", 63 | "i" = "it returned a vector of length {length(x)}." 64 | )) 65 | } 66 | 67 | if (any(is.na(x))) { 68 | throw(pkg_error( 69 | "{.fun assert_that}: assertion must not return {.code NA}." 70 | )) 71 | } 72 | 73 | TRUE 74 | } 75 | 76 | get_message <- function(res, call, env = parent.frame()) { 77 | if (has_attr(res, "msg")) { 78 | return(attr(res, "msg")) 79 | } 80 | 81 | f <- eval(call[[1]], env) 82 | if (is.call(call) && !is.primitive(f)) call <- match.call(f, call) 83 | fname <- deparse(call[[1]]) 84 | 85 | base_fs[[fname]] %||% fail_default(call, env) 86 | } 87 | 88 | # The default failure message works in the same way as stopifnot, so you can 89 | # continue to use any function that returns a logical value: you just won't 90 | # get a friendly error message. 91 | # The code below says you get the first 60 characters plus a ... 92 | fail_default <- function(call, env) { 93 | call_string <- deparse(call, width.cutoff = 60L) 94 | if (length(call_string) > 1L) { 95 | call_string <- paste0(call_string[1L], "...") 96 | } 97 | 98 | paste0(call_string, " is not true") 99 | } 100 | 101 | has_attr <- function(x, which) { 102 | if (!is.null(attr(x, which, exact = TRUE))) return(TRUE) 103 | structure( 104 | FALSE, 105 | msg = "{.arg {(.arg)}} must have attribute {.code {which}}.", 106 | env = environment() 107 | ) 108 | } 109 | "%has_attr%" <- has_attr 110 | 111 | base_fs <- new.env(parent = emptyenv()) 112 | 113 | # nocov start 114 | 115 | logical_is_not <- function(failed) { 116 | paste0("{.arg {(.arg)}} must ", failed, " {.arg {(.arg2)}}.") 117 | } 118 | 119 | base_fs$"==" <- logical_is_not("equal") 120 | base_fs$"<" <- logical_is_not("be less than") 121 | base_fs$">" <- logical_is_not("be greater than") 122 | base_fs$">=" <- logical_is_not("be greater than or equal to") 123 | base_fs$"<=" <- logical_is_not("be less than or equal to") 124 | base_fs$"!=" <- logical_is_not("not be equal to") 125 | 126 | is_not <- function(thing) { 127 | paste0("{.arg {(.arg)}} must be ", thing, ".") 128 | } 129 | 130 | # nocov end 131 | 132 | # Vectors 133 | base_fs$is.atomic <- is_not("an atomic vector") 134 | base_fs$is.character <- is_not("a character vector") 135 | base_fs$is.complex <- is_not("a complex vector") 136 | base_fs$is.double <- is_not("a numeric vector") 137 | base_fs$is.integer <- is_not("an integer vector") 138 | base_fs$is.numeric <- is_not("a numeric or integer vector") 139 | base_fs$is.raw <- is_not("a raw vector") 140 | base_fs$is.vector <- is_not("an atomic vector without attributes") 141 | 142 | # Factors 143 | base_fs$is.factor <- is_not("a factor") 144 | base_fs$is.ordered <- is_not("an ordered factor") 145 | 146 | # More complicated data structures 147 | base_fs$is.array <- is_not("an array") 148 | base_fs$is.data.frame <- is_not("a data frame") 149 | base_fs$is.list <- is_not("a list") 150 | base_fs$is.matrix <- is_not("a matrix") 151 | base_fs$is.null <- is_not("{.code NULL}") 152 | 153 | # Functions and environments 154 | base_fs$is.environment <- is_not("an environment") 155 | base_fs$is.function <- is_not("a function") 156 | base_fs$is.primitive <- is_not("a primitive function") 157 | 158 | # Computing on the language 159 | base_fs$is.call <- is_not("a quoted call") 160 | base_fs$is.expression <- is_not("an expression object") 161 | base_fs$is.name <- is_not("a name") 162 | base_fs$is.pairlist <- is_not("a pairlist") 163 | base_fs$is.recursive <- is_not("a recursive object") 164 | base_fs$is.symbol <- is_not("a name") 165 | 166 | # Catch all 167 | base_fs$"&&" <- 168 | "{.arg {(.arg)}} and {.arg {(.arg2)}} must both be true." 169 | 170 | base_fs$"||" <- 171 | "One of {.arg {(.arg)}} and {.arg {(.arg2)}} must be true." 172 | 173 | base_fs$any <- 174 | "At least one of {.arg {(.arg)}} must be true." 175 | 176 | base_fs$all <- 177 | "All of {.arg {(.arg)}} must be true." 178 | 179 | base_fs$file.exists <- 180 | "Path {.arg {(.arg)}} must exist." 181 | 182 | base_fs$identical <- 183 | "{.arg {(.arg)}} must be identical to {.arg {(.arg2)}}." 184 | -------------------------------------------------------------------------------- /R/check.R: -------------------------------------------------------------------------------- 1 | 2 | #' Check a package on R-hub 3 | #' 4 | #' @param gh_url GitHub URL of a package to check, or `NULL` to check 5 | #' the package in the current directory. 6 | #' @param platforms Platforms to use, a character vector. Use `NULL` to 7 | #' select from a list in interactive sessions. See [rhub_platforms()]. 8 | #' @param r_versions Which R version(s) to use for the platforms that 9 | #' supports multiple R versions. This arguemnt is not implemented yet. 10 | #' @param branch Branch to use to run R-hub. Defaults to the current 11 | #' branch if `gh_url` is `NULL`. Otherwise defaults to `"main"`. Note that 12 | #' this branch also need to include the `rhub.yaml` workflow file. 13 | #' @return TODO 14 | #' 15 | #' @export 16 | 17 | rhub_check <- function(gh_url = NULL, platforms = NULL, r_versions = NULL, 18 | branch = NULL) { 19 | assert_that( 20 | is_optional_gh_url(gh_url), 21 | is.null(platforms) || is_character(platforms), 22 | is_optional_string(branch) 23 | ) 24 | 25 | git_root <- if (is.null(gh_url)) setup_find_git_root() 26 | pat_url <- gh_url %||% "https://github.com" 27 | pat <- doctor_find_pat(pat_url) 28 | gh_url <- gh_url %||% doctor_find_gh_url(repo = git_root) 29 | 30 | if (is.null(branch)) { 31 | if (!is.null(git_root)) { 32 | branch <- gert::git_branch(repo = git_root) 33 | } else { 34 | branch <- "main" 35 | } 36 | } 37 | 38 | tryCatch( 39 | plat <- rhub_platforms(), 40 | error = function(e) { 41 | throw(parent = e, pkg_error( 42 | "Failed to download the list of R-hub platforms.", 43 | i = "Make sure that you are online and Github is also online." 44 | )) 45 | } 46 | ) 47 | 48 | if (is.null(platforms)) { 49 | if (!interactive()) { 50 | throw(pkg_error( 51 | "{.arg platforms} argument is missing for {.fun rhub_check}.", 52 | i = "You need to specify {.arg platforms} in non-interactive 53 | sessions" 54 | )) 55 | } 56 | cli::cli_text() 57 | cli::cli_text( 58 | "Available platforms 59 | (see {.code rhub2::rhub_platforms()} for details):" 60 | ) 61 | cli::cli_text() 62 | cli::cli_verbatim(paste( 63 | cli::ansi_strtrim(format(summary(plat))), 64 | collapse = "\n" 65 | )) 66 | pnums <- trimws(readline( 67 | prompt = "\nSelection (comma separated numbers, 0 to cancel): " 68 | )) 69 | if (pnums == "" || pnums == "0") { 70 | throw(pkg_error("R-hub check cancelled")) 71 | } 72 | pnums <- unique(trimws(strsplit(pnums, ",", fixed = TRUE)[[1]])) 73 | pnums2 <- suppressWarnings(as.integer(pnums)) 74 | bad <- is.na(pnums2) | pnums2 < 1 | pnums2 > nrow(plat) 75 | if (any(bad)) { 76 | throw(pkg_error( 77 | "Invalid platform number{?s}: {.val {pnums[bad]}}." 78 | )) 79 | } 80 | platforms <- plat$name[pnums2] 81 | 82 | } else { 83 | platforms <- unique(platforms) 84 | bad <- !platforms %in% unlist(plat$name, plat$aliaeses) 85 | if (any(bad)) { 86 | throw(pkg_error( 87 | "Unknown platform{?s}: {.val {platforms[bad]}}.", 88 | i = "See {.run rhub::rhub_platforms()} for the list of platforms" 89 | )) 90 | } 91 | } 92 | 93 | url <- parse_gh_url(gh_url) 94 | ep <- glue::glue("/repos/{url$user}/{url$repo}/actions/workflows/rhub.yaml/dispatches") 95 | config <- list(platforms = platforms) 96 | name <- paste(platforms, collapse = ", ") 97 | id <- random_id() 98 | data <- list( 99 | ref = branch, 100 | inputs = list( 101 | config = jsonlite::toJSON(config, auto_unbox = TRUE), 102 | name = name, 103 | id = id 104 | ) 105 | ) 106 | jsondata <- jsonlite::toJSON(data, auto_unbox = TRUE) 107 | 108 | resp <- gh_rest_post(url$api, ep, token = pat, data = jsondata) 109 | 110 | if (resp$status_code != 204) { 111 | throw(pkg_error( 112 | ":( Failed to start check: {resp$content$message}.", 113 | i = "If you think this is a bug in the {.pkg rhub2} package, please 114 | open an issues at {.url https://github.com/r-hub/rhub/issues}." 115 | )) 116 | } 117 | 118 | aurl <- paste0("https://", url$host, "/", url$user, "/", url$repo, "/actions") 119 | cli::cli_text() 120 | cli::cli_bullets(c( 121 | "v" = "Check started: {name} ({id}).", 122 | " " = "See {.url {aurl}} for live output!" 123 | )) 124 | 125 | 126 | invisible(NULL) 127 | } 128 | -------------------------------------------------------------------------------- /R/cli.R: -------------------------------------------------------------------------------- 1 | 2 | cli_status <- function(msg, ..., .auto_close = FALSE) { 3 | msg 4 | cli::cli_status( 5 | msg = "{.alert {msg}}", 6 | msg_done = "{.alert-success {msg}}", 7 | msg_failed = "{.alert-danger {msg}}", 8 | .auto_close = .auto_close, 9 | ... 10 | ) 11 | } 12 | -------------------------------------------------------------------------------- /R/compat-vctrs.R: -------------------------------------------------------------------------------- 1 | 2 | # nocov start 3 | 4 | compat_vctrs <- local({ 5 | 6 | # Modified from https://github.com/r-lib/rlang/blob/master/R/compat-vctrs.R 7 | 8 | # Construction ------------------------------------------------------------ 9 | 10 | # Constructs data frames inheriting from `"tbl"`. This allows the 11 | # pillar package to take over printing as soon as it is loaded. 12 | # The data frame otherwise behaves like a base data frame. 13 | data_frame <- function(...) { 14 | new_data_frame(df_list(...), .class = "tbl") 15 | } 16 | 17 | new_data_frame <- function(.x = list(), 18 | ..., 19 | .size = NULL, 20 | .class = NULL) { 21 | n_cols <- length(.x) 22 | if (n_cols != 0 && is.null(names(.x))) { 23 | stop("Columns must be named.", call. = FALSE) 24 | } 25 | 26 | if (is.null(.size)) { 27 | if (n_cols == 0) { 28 | .size <- 0 29 | } else { 30 | .size <- vec_size(.x[[1]]) 31 | } 32 | } 33 | 34 | structure( 35 | .x, 36 | class = c(.class, "data.frame"), 37 | row.names = .set_row_names(.size), 38 | ... 39 | ) 40 | } 41 | 42 | df_list <- function(..., .size = NULL) { 43 | vec_recycle_common(list(...), size = .size) 44 | } 45 | 46 | 47 | # Binding ----------------------------------------------------------------- 48 | 49 | vec_rbind <- function(...) { 50 | xs <- vec_cast_common(list(...)) 51 | do.call(base::rbind, xs) 52 | } 53 | 54 | vec_cbind <- function(...) { 55 | xs <- list(...) 56 | 57 | ptype <- vec_ptype_common(lapply(xs, `[`, 0)) 58 | class <- setdiff(class(ptype), "data.frame") 59 | 60 | xs <- vec_recycle_common(xs) 61 | out <- do.call(base::cbind, xs) 62 | new_data_frame(out, .class = class) 63 | } 64 | 65 | 66 | # Slicing ----------------------------------------------------------------- 67 | 68 | vec_size <- function(x) { 69 | if (is.data.frame(x)) { 70 | nrow(x) 71 | } else { 72 | length(x) 73 | } 74 | } 75 | 76 | vec_rep <- function(x, times) { 77 | i <- rep.int(seq_len(vec_size(x)), times) 78 | vec_slice(x, i) 79 | } 80 | 81 | vec_recycle_common <- function(xs, size = NULL) { 82 | sizes <- vapply(xs, vec_size, integer(1)) 83 | 84 | n <- unique(sizes) 85 | 86 | if (length(n) == 1 && is.null(size)) { 87 | return(xs) 88 | } 89 | n <- setdiff(n, 1L) 90 | 91 | ns <- length(n) 92 | 93 | if (ns == 0) { 94 | if (is.null(size)) { 95 | return(xs) 96 | } 97 | } else if (ns == 1) { 98 | if (is.null(size)) { 99 | size <- n 100 | } else if (ns != size) { 101 | stop("Inputs can't be recycled to `size`.", call. = FALSE) 102 | } 103 | } else { 104 | stop("Inputs can't be recycled to a common size.", call. = FALSE) 105 | } 106 | 107 | to_recycle <- sizes == 1L 108 | xs[to_recycle] <- lapply(xs[to_recycle], vec_rep, size) 109 | 110 | xs 111 | } 112 | 113 | vec_slice <- function(x, i) { 114 | if (is.logical(i)) { 115 | i <- which(i) 116 | } 117 | stopifnot(is.numeric(i) || is.character(i)) 118 | 119 | if (is.null(x)) { 120 | return(NULL) 121 | } 122 | 123 | if (is.data.frame(x)) { 124 | # We need to be a bit careful to be generic. First empty all 125 | # columns and expand the df to final size. 126 | out <- x[i, 0, drop = FALSE] 127 | 128 | # Then fill in with sliced columns 129 | out[seq_along(x)] <- lapply(x, vec_slice, i) 130 | 131 | # Reset automatic row names to work around `[` weirdness 132 | if (is.numeric(attr(x, "row.names"))) { 133 | row_names <- .set_row_names(nrow(out)) 134 | } else { 135 | row_names <- attr(out, "row.names") 136 | } 137 | 138 | return(out) 139 | } 140 | 141 | d <- vec_dims(x) 142 | if (d == 1) { 143 | if (is.object(x)) { 144 | out <- x[i] 145 | } else { 146 | out <- x[i, drop = FALSE] 147 | } 148 | } else if (d == 2) { 149 | out <- x[i, , drop = FALSE] 150 | } else { 151 | j <- rep(list(quote(expr = )), d - 1) 152 | out <- eval(as.call(list(quote(`[`), quote(x), quote(i), j, drop = FALSE))) 153 | } 154 | 155 | out 156 | } 157 | vec_dims <- function(x) { 158 | d <- dim(x) 159 | if (is.null(d)) { 160 | 1L 161 | } else { 162 | length(d) 163 | } 164 | } 165 | 166 | vec_as_location <- function(i, n, names = NULL) { 167 | out <- seq_len(n) 168 | names(out) <- names 169 | 170 | # Special-case recycling to size 0 171 | if (is_logical(i, n = 1) && !length(out)) { 172 | return(out) 173 | } 174 | 175 | unname(out[i]) 176 | } 177 | 178 | vec_init <- function(x, n = 1L) { 179 | vec_slice(x, rep_len(NA_integer_, n)) 180 | } 181 | 182 | vec_assign <- function(x, i, value) { 183 | if (is.null(x)) { 184 | return(NULL) 185 | } 186 | 187 | if (is.logical(i)) { 188 | i <- which(i) 189 | } 190 | stopifnot( 191 | is.numeric(i) || is.character(i) 192 | ) 193 | 194 | value <- vec_recycle(value, vec_size(i)) 195 | value <- vec_cast(value, to = x) 196 | 197 | d <- vec_dims(x) 198 | 199 | if (d == 1) { 200 | x[i] <- value 201 | } else if (d == 2) { 202 | x[i, ] <- value 203 | } else { 204 | stop("Can't slice-assign arrays.", call. = FALSE) 205 | } 206 | 207 | x 208 | } 209 | 210 | vec_recycle <- function(x, size) { 211 | if (is.null(x) || is.null(size)) { 212 | return(NULL) 213 | } 214 | 215 | n_x <- vec_size(x) 216 | 217 | if (n_x == size) { 218 | x 219 | } else if (size == 0L) { 220 | vec_slice(x, 0L) 221 | } else if (n_x == 1L) { 222 | vec_slice(x, rep(1L, size)) 223 | } else { 224 | stop("Incompatible lengths: ", n_x, ", ", size, call. = FALSE) 225 | } 226 | } 227 | 228 | 229 | # Coercion ---------------------------------------------------------------- 230 | 231 | vec_cast_common <- function(xs, to = NULL) { 232 | ptype <- vec_ptype_common(xs, ptype = to) 233 | lapply(xs, vec_cast, to = ptype) 234 | } 235 | 236 | vec_cast <- function(x, to) { 237 | if (is.null(x)) { 238 | return(NULL) 239 | } 240 | if (is.null(to)) { 241 | return(x) 242 | } 243 | 244 | if (vec_is_unspecified(x)) { 245 | return(vec_init(to, vec_size(x))) 246 | } 247 | 248 | stop_incompatible_cast <- function(x, to) { 249 | stop( 250 | sprintf("Can't convert <%s> to <%s>.", 251 | .rlang_vctrs_typeof(x), 252 | .rlang_vctrs_typeof(to) 253 | ), 254 | call. = FALSE 255 | ) 256 | } 257 | 258 | lgl_cast <- function(x, to) { 259 | lgl_cast_from_num <- function(x) { 260 | if (any(!x %in% c(0L, 1L))) { 261 | stop_incompatible_cast(x, to) 262 | } 263 | as.logical(x) 264 | } 265 | 266 | switch( 267 | .rlang_vctrs_typeof(x), 268 | logical = x, 269 | integer = , 270 | double = lgl_cast_from_num(x), 271 | stop_incompatible_cast(x, to) 272 | ) 273 | } 274 | 275 | int_cast <- function(x, to) { 276 | int_cast_from_dbl <- function(x) { 277 | out <- suppressWarnings(as.integer(x)) 278 | if (any((out != x) | xor(is.na(x), is.na(out)))) { 279 | stop_incompatible_cast(x, to) 280 | } else { 281 | out 282 | } 283 | } 284 | 285 | switch( 286 | .rlang_vctrs_typeof(x), 287 | logical = as.integer(x), 288 | integer = x, 289 | double = int_cast_from_dbl(x), 290 | stop_incompatible_cast(x, to) 291 | ) 292 | } 293 | 294 | dbl_cast <- function(x, to) { 295 | switch( 296 | .rlang_vctrs_typeof(x), 297 | logical = , 298 | integer = as.double(x), 299 | double = x, 300 | stop_incompatible_cast(x, to) 301 | ) 302 | } 303 | 304 | chr_cast <- function(x, to) { 305 | switch( 306 | .rlang_vctrs_typeof(x), 307 | character = x, 308 | stop_incompatible_cast(x, to) 309 | ) 310 | } 311 | 312 | list_cast <- function(x, to) { 313 | switch( 314 | .rlang_vctrs_typeof(x), 315 | list = x, 316 | stop_incompatible_cast(x, to) 317 | ) 318 | } 319 | 320 | df_cast <- function(x, to) { 321 | # Check for extra columns 322 | if (length(setdiff(names(x), names(to))) > 0 ) { 323 | stop("Can't convert data frame because of missing columns.", call. = FALSE) 324 | } 325 | 326 | # Avoid expensive [.data.frame method 327 | out <- as.list(x) 328 | 329 | # Coerce common columns 330 | common <- intersect(names(x), names(to)) 331 | out[common] <- Map(vec_cast, out[common], to[common]) 332 | 333 | # Add new columns 334 | from_type <- setdiff(names(to), names(x)) 335 | out[from_type] <- lapply(to[from_type], vec_init, n = vec_size(x)) 336 | 337 | # Ensure columns are ordered according to `to` 338 | out <- out[names(to)] 339 | 340 | new_data_frame(out) 341 | } 342 | 343 | rlib_df_cast <- function(x, to) { 344 | new_data_frame(df_cast(x, to), .class = "tbl") 345 | } 346 | tib_cast <- function(x, to) { 347 | new_data_frame(df_cast(x, to), .class = c("tbl_df", "tbl")) 348 | } 349 | 350 | switch( 351 | .rlang_vctrs_typeof(to), 352 | logical = lgl_cast(x, to), 353 | integer = int_cast(x, to), 354 | double = dbl_cast(x, to), 355 | character = chr_cast(x, to), 356 | list = list_cast(x, to), 357 | 358 | base_data_frame = df_cast(x, to), 359 | rlib_data_frame = rlib_df_cast(x, to), 360 | tibble = tib_cast(x, to), 361 | 362 | stop_incompatible_cast(x, to) 363 | ) 364 | } 365 | 366 | vec_ptype_common <- function(xs, ptype = NULL) { 367 | if (!is.null(ptype)) { 368 | return(vec_ptype(ptype)) 369 | } 370 | 371 | xs <- Filter(function(x) !is.null(x), xs) 372 | 373 | if (length(xs) == 0) { 374 | return(NULL) 375 | } 376 | 377 | if (length(xs) == 1) { 378 | out <- vec_ptype(xs[[1]]) 379 | } else { 380 | xs <- map(xs, vec_ptype) 381 | out <- Reduce(vec_ptype2, xs) 382 | } 383 | 384 | vec_ptype_finalise(out) 385 | } 386 | 387 | vec_ptype_finalise <- function(x) { 388 | if (is.data.frame(x)) { 389 | x[] <- lapply(x, vec_ptype_finalise) 390 | return(x) 391 | } 392 | 393 | if (inherits(x, "rlang_unspecified")) { 394 | logical() 395 | } else { 396 | x 397 | } 398 | } 399 | 400 | vec_ptype <- function(x) { 401 | if (vec_is_unspecified(x)) { 402 | return(.rlang_vctrs_unspecified()) 403 | } 404 | 405 | if (is.data.frame(x)) { 406 | out <- new_data_frame(lapply(x, vec_ptype)) 407 | 408 | attrib <- attributes(x) 409 | attrib$row.names <- attr(out, "row.names") 410 | attributes(out) <- attrib 411 | 412 | return(out) 413 | } 414 | 415 | vec_slice(x, 0) 416 | } 417 | 418 | vec_ptype2 <- function(x, y) { 419 | stop_incompatible_type <- function(x, y) { 420 | stop( 421 | sprintf("Can't combine types <%s> and <%s>.", 422 | .rlang_vctrs_typeof(x), 423 | .rlang_vctrs_typeof(y)), 424 | call. = FALSE 425 | ) 426 | } 427 | 428 | x_type <- .rlang_vctrs_typeof(x) 429 | y_type <- .rlang_vctrs_typeof(y) 430 | 431 | if (x_type == "unspecified" && y_type == "unspecified") { 432 | return(.rlang_vctrs_unspecified()) 433 | } 434 | if (x_type == "unspecified") { 435 | return(y) 436 | } 437 | if (y_type == "unspecified") { 438 | return(x) 439 | } 440 | 441 | df_ptype2 <- function(x, y) { 442 | set_partition <- function(x, y) { 443 | list( 444 | both = intersect(x, y), 445 | only_x = setdiff(x, y), 446 | only_y = setdiff(y, x) 447 | ) 448 | } 449 | 450 | # Avoid expensive [.data.frame 451 | x <- as.list(vec_slice(x, 0)) 452 | y <- as.list(vec_slice(y, 0)) 453 | 454 | # Find column types 455 | names <- set_partition(names(x), names(y)) 456 | if (length(names$both) > 0) { 457 | common_types <- Map(vec_ptype2, x[names$both], y[names$both]) 458 | } else { 459 | common_types <- list() 460 | } 461 | only_x_types <- x[names$only_x] 462 | only_y_types <- y[names$only_y] 463 | 464 | # Combine and construct 465 | out <- c(common_types, only_x_types, only_y_types) 466 | out <- out[c(names(x), names$only_y)] 467 | new_data_frame(out) 468 | } 469 | 470 | rlib_df_ptype2 <- function(x, y) { 471 | new_data_frame(df_ptype2(x, y), .class = "tbl") 472 | } 473 | tib_ptype2 <- function(x, y) { 474 | new_data_frame(df_ptype2(x, y), .class = c("tbl_df", "tbl")) 475 | } 476 | 477 | ptype <- switch( 478 | x_type, 479 | 480 | logical = switch( 481 | y_type, 482 | logical = x, 483 | integer = y, 484 | double = y, 485 | stop_incompatible_type(x, y) 486 | ), 487 | 488 | integer = switch( 489 | .rlang_vctrs_typeof(y), 490 | logical = x, 491 | integer = x, 492 | double = y, 493 | stop_incompatible_type(x, y) 494 | ), 495 | 496 | double = switch( 497 | .rlang_vctrs_typeof(y), 498 | logical = x, 499 | integer = x, 500 | double = x, 501 | stop_incompatible_type(x, y) 502 | ), 503 | 504 | character = switch( 505 | .rlang_vctrs_typeof(y), 506 | character = x, 507 | stop_incompatible_type(x, y) 508 | ), 509 | 510 | list = switch( 511 | .rlang_vctrs_typeof(y), 512 | list = x, 513 | stop_incompatible_type(x, y) 514 | ), 515 | 516 | base_data_frame = switch( 517 | .rlang_vctrs_typeof(y), 518 | base_data_frame = , 519 | s3_data_frame = df_ptype2(x, y), 520 | rlib_data_frame = rlib_df_ptype2(x, y), 521 | tibble = tib_ptype2(x, y), 522 | stop_incompatible_type(x, y) 523 | ), 524 | 525 | rlib_data_frame = switch( 526 | .rlang_vctrs_typeof(y), 527 | base_data_frame = , 528 | rlib_data_frame = , 529 | s3_data_frame = rlib_df_ptype2(x, y), 530 | tibble = tib_ptype2(x, y), 531 | stop_incompatible_type(x, y) 532 | ), 533 | 534 | tibble = switch( 535 | .rlang_vctrs_typeof(y), 536 | base_data_frame = , 537 | rlib_data_frame = , 538 | tibble = , 539 | s3_data_frame = tib_ptype2(x, y), 540 | stop_incompatible_type(x, y) 541 | ), 542 | 543 | stop_incompatible_type(x, y) 544 | ) 545 | 546 | vec_slice(ptype, 0) 547 | } 548 | 549 | .rlang_vctrs_typeof <- function(x) { 550 | if (is.object(x)) { 551 | class <- class(x) 552 | 553 | if (identical(class, "rlang_unspecified")) { 554 | return("unspecified") 555 | } 556 | if (identical(class, "data.frame")) { 557 | return("base_data_frame") 558 | } 559 | if (identical(class, c("tbl", "data.frame"))) { 560 | return("rlib_data_frame") 561 | } 562 | if (identical(class, c("tbl_df", "tbl", "data.frame"))) { 563 | return("tibble") 564 | } 565 | if (inherits(x, "data.frame")) { 566 | return("s3_data_frame") 567 | } 568 | 569 | class <- paste0(class, collapse = "/") 570 | stop(sprintf("Unimplemented class <%s>.", class), call. = FALSE) 571 | } 572 | 573 | type <- typeof(x) 574 | switch( 575 | type, 576 | NULL = return("null"), 577 | logical = if (vec_is_unspecified(x)) { 578 | return("unspecified") 579 | } else { 580 | return(type) 581 | }, 582 | integer = , 583 | double = , 584 | character = , 585 | raw = , 586 | list = return(type) 587 | ) 588 | 589 | stop(sprintf("Unimplemented type <%s>.", type), call. = FALSE) 590 | } 591 | 592 | vec_is_unspecified <- function(x) { 593 | !is.object(x) && 594 | typeof(x) == "logical" && 595 | length(x) && 596 | all(vapply(x, identical, logical(1), NA)) 597 | } 598 | 599 | .rlang_vctrs_unspecified <- function(x = NULL) { 600 | structure( 601 | rep(NA, length(x)), 602 | class = "rlang_unspecified" 603 | ) 604 | } 605 | 606 | .rlang_vctrs_s3_method <- function(generic, class, env = parent.frame()) { 607 | fn <- get(generic, envir = env) 608 | 609 | ns <- asNamespace(topenv(fn)) 610 | tbl <- ns$.__S3MethodsTable__. 611 | 612 | for (c in class) { 613 | name <- paste0(generic, ".", c) 614 | if (exists(name, envir = tbl, inherits = FALSE)) { 615 | return(get(name, envir = tbl)) 616 | } 617 | if (exists(name, envir = globalenv(), inherits = FALSE)) { 618 | return(get(name, envir = globalenv())) 619 | } 620 | } 621 | 622 | NULL 623 | } 624 | 625 | environment() 626 | 627 | }) 628 | 629 | data_frame <- compat_vctrs$data_frame 630 | 631 | as_data_frame <- function(x) { 632 | if (is.matrix(x)) { 633 | x <- as.data.frame(x, stringsAsFactors = FALSE) 634 | } else { 635 | x <- compat_vctrs$vec_recycle_common(x) 636 | } 637 | compat_vctrs$new_data_frame(x, .class = "tbl") 638 | } 639 | 640 | # nocov end 641 | -------------------------------------------------------------------------------- /R/doctor.R: -------------------------------------------------------------------------------- 1 | 2 | #' Check if the current or the specified package is ready to use with R-hub 3 | #' 4 | #' Errors if the package or repository is not set up correctly, and 5 | #' advises on possible solutions. 6 | #' 7 | #' @param gh_url Use `NULL` for the package in the current working 8 | #' directory. Alternatively, use the URL of a GitHub repository that 9 | #' contains an R package that was set up to use with R-hub. 10 | #' 11 | #' @export 12 | 13 | rhub_doctor <- function(gh_url = NULL) { 14 | assert_that( 15 | is_optional_gh_url(gh_url) 16 | ) 17 | 18 | rpkg_root <- if (is.null(gh_url)) setup_find_r_package() 19 | git_root <- if (is.null(gh_url)) setup_find_git_root() 20 | if (is.null(gh_url)) check_rpkg_root(rpkg_root, git_root) 21 | 22 | pat_url <- gh_url %||% "https://github.com" 23 | pat <- doctor_find_pat(pat_url) 24 | gh_url <- gh_url %||% doctor_find_gh_url(repo = git_root) 25 | 26 | # ----------------------------------------------------------------------- 27 | # Do these up front, concurrently 28 | # We need the following pieces: 29 | # 1 check if we are indeed talking to GitHub 30 | # 2 check that the token is valid, and we have access to the repo 31 | # 3 check that the token has the right scopes 32 | # 4 check that the workflow file exists on the default branch 33 | # 5 check that the workflow exists (e.g. not a fork with disabled actions) 34 | # 6 check that the workflow is enabled 35 | # 7 check that the workflow file is the latest version 36 | # 37 | # Unfortunately we cannot do all this with a single graphql query, because 38 | # (AFAICT) you cannot currently query the workflows of a repository with 39 | # GraphQL. 40 | # 41 | # So we'll have 42 | # - a graphql query for (1), (2), (3), (4), (7) 43 | # - a REST query for (5) and (6) 44 | 45 | resp <- synchronise(when_all( 46 | gql = doctor_async_gql(gh_url, token = pat), 47 | wfl = doctor_async_rest(gh_url, token = pat) 48 | )) 49 | 50 | doctor_check_github(gh_url, resp$gql) 51 | doctor_check_pat_scopes(resp$gql) 52 | doctor_check_workflow(gh_url, resp$gql, resp$wfl) 53 | 54 | cli::cli_alert( 55 | "WOOT! You are ready to run {.run rhub2::rhub_check()} on this package.", 56 | wrap = TRUE 57 | ) 58 | 59 | invisible(NULL) 60 | } 61 | 62 | # TODO: multiple remotes, what if it is not origin? 63 | # TODO: what if there is a remote, but it does not have a URL? 64 | 65 | doctor_find_gh_url <- function(repo) { 66 | remote <- gert::git_info(repo)$remote 67 | if (is.na(remote)) { 68 | throw(pkg_error( 69 | call. = FALSE, 70 | "Cannot determine GitHub URL from git remote in repository at 71 | {.file {repo}}. Is your repository on GitHub?", 72 | i = "If this repository is on GitHub, call 73 | {.code git remote add origin } to add GitHub as a 74 | remote.", 75 | i = "Alternatively, specify the GitHub URL of the repository in 76 | the {.arg gh_url} argument.", 77 | i = "If it is not on GitHub, then you'll need to put it there. 78 | Create a new repository at {.url https://github.com/new}." 79 | )) 80 | } 81 | gert::git_remote_info(repo = repo)$url 82 | } 83 | 84 | doctor_find_pat <- function(pat_url) { 85 | pid <- cli_status("Do you have a GitHub personal access token (PAT)?") 86 | # TODO: get GH URL from git remote, if any 87 | tryCatch( 88 | pat <- gitcreds::gitcreds_get(url = pat_url)$password, 89 | gitcreds_nogit_error = function(e) { 90 | cli::cli_status_clear(pid, result = "failed") 91 | env <- gitcreds::gitcreds_cache_envvar(pat_url) 92 | throw(pkg_error( 93 | call. = FALSE, 94 | "Could not find a GitHub personal access token (PAT) for {.url {pat_url}}.", 95 | i = "I also could not find a working git installation. If you 96 | don't want to install git, but you have a PAT, you can set the 97 | {.env {env}} environment variable to the PAT.", 98 | i = "You can read more about PATs at 99 | {.url https://usethis.r-lib.org/articles/git-credentials.html}." 100 | )) 101 | }, 102 | gitcreds_no_credentials = function(e) { 103 | cli::cli_status_clear(pid, result = "failed") 104 | env <- gitcreds::gitcreds_cache_envvar(pat_url) 105 | throw(pkg_error( 106 | call. = FALSE, 107 | "Could not find a GitHub personal access token (PAT) for {.url {pat_url}}.", 108 | i = "If you have a GitHub PAT, you can use {.run gitcreds::gitcreds_set()} 109 | to add it to the git credential store, so R-hub can use it.", 110 | i = "If you don't have a PAT, you can create one by running 111 | {.run usethis::create_github_token()}.", 112 | i = "You can read more about PATs at 113 | {.url https://usethis.r-lib.org/articles/git-credentials.html}." 114 | )) 115 | }, 116 | error = function(e) { 117 | cli::cli_status_clear(pid, result = "failed") 118 | throw(e) 119 | } 120 | ) 121 | cli::cli_status_clear(pid, result = "clear") 122 | cli::cli_alert_success("Found GitHub PAT.") 123 | 124 | pat 125 | } 126 | 127 | doctor_check_github <- function(gh_url, resp) { 128 | pid <- cli_status(cli::format_inline("Is the package on GitHub at {.url {gh_url}}?")) 129 | if (!"x-ratelimit-limit" %in% names(resp$headers)) { 130 | cli::cli_status_clear(pid, result = "failed") 131 | throw(pkg_error( 132 | call. = FALSE, 133 | "Remote repository at {.url {gh_url}} does not seem like a GitHub 134 | repository.", 135 | i = "R-hub only supports GitHub packages in GitHub repositories 136 | currently.", 137 | i = "If you think that this is a bug in the {pkg rhub2} package, 138 | please let us know!" 139 | )) 140 | } 141 | cli::cli_status_clear(pid, result = "clear") 142 | cli::cli_alert_success( 143 | "Found repository on GitHub at {.url {gh_url}}.", 144 | wrap = TRUE 145 | ) 146 | } 147 | 148 | # we can assume a GH response at this point 149 | 150 | doctor_check_pat_scopes <- function(resp) { 151 | pid <- cli_status("Does your GitHub PAT have the right scopes?") 152 | scopes <- trimws(strsplit( 153 | resp[["headers"]][["x-oauth-scopes"]] %||% "NOPE", 154 | ",", 155 | fixed = TRUE 156 | )[[1]]) 157 | 158 | if (identical(scopes, "NOPE")) { 159 | cli::cli_status_clear(pid, result = "failed") 160 | throw(pkg_error( 161 | call. = FALSE, 162 | "Could not use the PAT to authenticate to GitHub", 163 | i = "Make sure that the URL and your PAT are correct." 164 | )) 165 | } 166 | 167 | if (!"repo" %in% scopes) { 168 | cli::cli_status_clear(pid, result = "failed") 169 | throw(pkg_error( 170 | call. = FALSE, 171 | "Your PAT does not have a {.code repo} scope.", 172 | i = "Withoput a {.code repo} scope R-hub cannot start jobs on GitHub.", 173 | i = "Change the scoped of the PAT on the GitHub web page, or create 174 | a new PAT." 175 | )) 176 | } 177 | cli::cli_status_clear(pid, result = "clear") 178 | cli::cli_alert_success("GitHub PAT has the right scopes.") 179 | } 180 | 181 | doctor_check_workflow <- function(gh_url, gql, rest) { 182 | pid <- cli_status( 183 | "Does the default branch of your git repo have the R-hub workflow file?" 184 | ) 185 | 186 | if (is.null(gql$workflow)) { 187 | cli::cli_status_clear(pid, result = "failed") 188 | throw(pkg_error( 189 | call. = FALSE, 190 | "Could not find R-hub's workflow file in the repository at 191 | {.url {gh_url}}.", 192 | i = "The workflow file must be at {.path .github/workflows/rhub.yaml}.", 193 | i = "If you have added and committed the workflow file, you need to 194 | push the commit to GitHub with {.code git push}.", 195 | i = if (isTRUE(gql$is_forked)) 196 | "This repository is a fork. Make sure you enabled GitHub Actions 197 | on it, in the {.emph Actions} tab of the repository web page." 198 | )) 199 | } 200 | 201 | if (rest$workflow$state != "active") { 202 | cli::cli_status_clear(pid, result = "failed") 203 | throw(pkg_error( 204 | call. = FALSE, 205 | "The workflow is disabled.", 206 | i = "You need to enable it, click on the {.code ...} button at the 207 | top right corner of the web page of the workflow." 208 | )) 209 | } 210 | 211 | cli::cli_status_clear(pid, result = "clear") 212 | cli::cli_alert_success( 213 | "Found R-hub workflow in default branch, and it is active." 214 | ) 215 | } 216 | 217 | # We need the following pieces: 218 | # - check if we are indeed talking to GitHub 219 | # - check that the token is valid, and we have access to the repo 220 | # - check that the token has the right scopes 221 | # - check that the workflow file exists on the default branch 222 | # - check that the workflow file is the latest version 223 | 224 | doctor_async_gql <- function(gh_url, token) { 225 | url <- parse_gh_url(gh_url) 226 | query <- glue::glue("{ 227 | repository(owner: \"\", name: \"\") { 228 | workflow_file: object(expression: \"HEAD:.github/workflows/rhub.yaml\") { 229 | ... on Blob { 230 | isBinary 231 | text 232 | } 233 | } 234 | sha: object(expression: \"HEAD\") { 235 | oid 236 | } 237 | branch: defaultBranchRef { 238 | name 239 | } 240 | isFork 241 | } 242 | }", .open = "<", .close = ">") 243 | async_gh_gql_get(url$graphql, query, token)$ 244 | then(function(resp) { 245 | data <- resp$content$data 246 | list( 247 | status_code = resp$status_code, 248 | headers = resp$headers, 249 | is_repo = !is.null(data$repository), 250 | workflow_binary = data$repository$workflow_file$isBinary, 251 | workflow = data$repository$workflow_file$text, 252 | sha = data$repository$sha$oid, 253 | branch = data$repository$branch$name, 254 | is_fork = data$repository$isFork, 255 | errors = resp$content$errors 256 | ) 257 | }) 258 | } 259 | 260 | # Goal is to 261 | # - check if workflow exist (e.g. not a form with disabled actions) 262 | # - check that workflow is enabled 263 | 264 | doctor_async_rest <- function(gh_url, token) { 265 | url <- parse_gh_url(gh_url) 266 | ep <- glue::glue("/repos/{url$user}/{url$repo}/actions/workflows/rhub.yaml") 267 | async_gh_rest_get(url$api, ep, token)$ 268 | then(function(resp) { 269 | list( 270 | status_code = resp$status_code, 271 | headers = resp$headers, 272 | workflow = resp$content, 273 | errors = resp$content$errors 274 | ) 275 | }) 276 | } 277 | -------------------------------------------------------------------------------- /R/gh.R: -------------------------------------------------------------------------------- 1 | 2 | parse_gh_url <- function(url) { 3 | pcs <- parse_url(url) 4 | host <- pcs$host 5 | if (pcs$host == "github.com") { 6 | api <- paste0(pcs$protocol, "://api.github.com") 7 | graphql <- paste0(pcs$protocol, "://api.github.com/graphql") 8 | } else { 9 | api <- paste0(pcs$protocol, "://", pcs$host, "/api/v3") 10 | graphql <- paste0(pcs$protocol, "://", pcs$host, "/api/graphql") 11 | } 12 | cmps <- strsplit(pcs$path, "/", fixed = TRUE)[[1]] 13 | if (cmps[1] == "") cmps <- cmps[-1] 14 | if (length(cmps) < 2) cmps <- c(cmps, "", "")[1:2] 15 | cmps[2] <- sub("[.]git$", "", cmps[2]) 16 | list( 17 | host = host, 18 | api = api, 19 | graphql = graphql, 20 | user = cmps[1], 21 | repo = cmps[2], 22 | slug = paste0(cmps[1], "/", cmps[2]) 23 | ) 24 | } 25 | 26 | gh_headers <- function(token) { 27 | c( 28 | Accept = "application/vnd.github+json", 29 | Authorization = paste0("Bearer ", token) 30 | ) 31 | } 32 | 33 | gh_query_process_response <- function(resp) { 34 | if (grepl("^application/json\\b", resp$type)) { 35 | resp$content <- jsonlite::fromJSON( 36 | rawToChar(resp$content), 37 | simplifyVector = FALSE 38 | ) 39 | } 40 | resp$headers <- curl::parse_headers_list(resp$headers) 41 | resp 42 | } 43 | 44 | gh_rest_get <- function(host, endpoint, token) { 45 | synchronise(async_gh_rest_get(host, endpoint, token = token)) 46 | } 47 | 48 | async_gh_rest_get <- function(host, endpoint, token) { 49 | url <- paste0(host, endpoint) 50 | headers <- gh_headers(token) 51 | http_get(url, headers = headers)$ 52 | then(gh_query_process_response) 53 | } 54 | 55 | gh_rest_post <- function(host, endpoint, token, data) { 56 | synchronise(async_gh_rest_post(host, endpoint, token, data)) 57 | } 58 | 59 | async_gh_rest_post <- function(host, endpoint, token, data) { 60 | url <- paste0(host, endpoint) 61 | headers <- gh_headers(token) 62 | http_post(url, data = data, headers = headers)$ 63 | then(gh_query_process_response) 64 | } 65 | 66 | gh_gql_get <- function(host, query, token) { 67 | synchronise(async_gh_rest_get(host, query, token)) 68 | } 69 | 70 | async_gh_gql_get <- function(host, query, token) { 71 | headers <- gh_headers(token) 72 | data <- jsonlite::toJSON(list(query = query), auto_unbox = TRUE) 73 | http_post(host, headers = headers, data = data)$ 74 | then(gh_query_process_response) 75 | } 76 | -------------------------------------------------------------------------------- /R/http-cache.R: -------------------------------------------------------------------------------- 1 | 2 | the_cache <- new.env(parent = emptyenv()) 3 | 4 | async_cached_http_get <- function(url, headers = character(), 5 | options = list()) { 6 | hash <- cli::hash_md5(paste0("http-get-", url)) 7 | if (hash %in% names(the_cache)) { 8 | async_constant(the_cache[[hash]]) 9 | } else { 10 | http_get(url, headers = headers, options = options)$ 11 | then(http_stop_for_status)$ 12 | then(function(response) { 13 | json <- rawToChar(response$content) 14 | the_cache[[hash]] <- json 15 | json 16 | }) 17 | } 18 | } 19 | -------------------------------------------------------------------------------- /R/platforms.R: -------------------------------------------------------------------------------- 1 | 2 | get_platforms <- function() { 3 | url_platforms <- "https://raw.githubusercontent.com/r-hub/rhub2/v1/actions/rhub-setup/platforms.json" 4 | url_containers <- "https://r-hub.github.io/containers/manifest.json" 5 | ret <- synchronise(when_all( 6 | async_cached_http_get(url_platforms), 7 | async_cached_http_get(url_containers) 8 | )) 9 | ret 10 | } 11 | 12 | #' List R-hub platforms 13 | #' 14 | #' @return Data frame with columns: 15 | #' * `name`: platform name. Use this in the `platforms` argument of 16 | #' [rhub_check()]. 17 | #' * `aliases`: alternative platform names. They can also be used in the 18 | #' `platforms` argument of [rhub_check()]. 19 | #' * `type`: `"os"` or `"container"`. 20 | #' * `os_type`: Linux, macOS or Windows currently. 21 | #' * `container`: URL of the container image for container platforms. 22 | #' * `github_os`: name of the OS on GitHub Actions for non-container 23 | #' platforms. 24 | #' * `r_version`: R version string. If `"*"` then any supported R version 25 | #' can be selected for this platform. 26 | #' * `os_name`: name of the operating system, including Linux distribution 27 | #' name and version for container actions. 28 | #' 29 | #' @export 30 | 31 | rhub_platforms <- function() { 32 | ret <- get_platforms() 33 | platforms <- jsonlite::fromJSON(ret[[1]]) 34 | containers <- jsonlite::fromJSON(ret[[2]], simplifyVector = FALSE)$containers 35 | 36 | res <- data_frame( 37 | name = platforms[["name"]], 38 | aliases = lapply(zip(platforms[["cran-names"]], platforms[["aliases"]]), unique), 39 | type = platforms[["type"]], 40 | os_type = platforms[["os-type"]], 41 | container = platforms[["container"]], 42 | github_os = platforms[["os"]], 43 | r_version = platforms[["r-version"]], 44 | os_name = NA_character_ 45 | ) 46 | 47 | wcnt <- res$type == "container" 48 | cnt_tags <- vcapply(containers, "[[", "tag") 49 | res$r_version[wcnt] <- vcapply(res$container[wcnt], function(x) { 50 | if (! x %in% cnt_tags) return(NA_character_) 51 | sess <- containers[[match(x, cnt_tags)]]$builds[[1]]$`sessionInfo()` 52 | strsplit(sess, "\n", fixed = TRUE)[[1]][1] 53 | }) 54 | 55 | res$os_name[wcnt] <- vcapply(res$container[wcnt], function(x) { 56 | if (! x %in% cnt_tags) return(NA_character_) 57 | osr <- containers[[match(x, cnt_tags)]]$builds[[1]]$`/etc/os-release` 58 | osr <- strsplit(osr, "\n", fixed = TRUE)[[1]] 59 | pn <- grep("^PRETTY_NAME", osr, value = TRUE)[1] 60 | pn <- sub("^PRETTY_NAME=", "", pn) 61 | pn <- unquote(pn) 62 | pn 63 | }) 64 | 65 | res <- res[order(res$type == "container", res$name), ] 66 | 67 | res <- add_class(res, "rhub2_platforms") 68 | res 69 | } 70 | 71 | #' @export 72 | 73 | format.rhub2_platforms <- function(x, ...) { 74 | ret <- character() 75 | wvms <- which(x$type == "os") 76 | wcts <- which(x$type == "container") 77 | counter <- 1L 78 | grey <- cli::make_ansi_style("gray70", grey = TRUE) 79 | if (length(wvms)) { 80 | vm <- if (has_emoji()) "\U1F5A5 " else "[VM] " 81 | ret <- c(ret, cli::rule("Virtual machines")) 82 | for (p in wvms) { 83 | ret <- c( 84 | ret, 85 | paste0( 86 | format(counter, width = 2), " ", vm, " ", 87 | cli::style_bold(cli::col_blue(x$name[p])) 88 | ), 89 | if (x$r_version[p] == "*") { 90 | grey(paste0(" All R versions on GitHub Actions ", x$github_os[p])) 91 | } else { 92 | x$r_version 93 | } 94 | ) 95 | counter <- counter + 1L 96 | } 97 | } 98 | if (length(wcts)) { 99 | if (length(ret)) ret <- c(ret, "") 100 | ret <- c(ret, cli::rule("Containers")) 101 | for (p in wcts) { 102 | ct <- if (has_emoji()) "\U1F40B" else "[CT] " 103 | rv <- x$r_version[p] 104 | os <- x$os_name[p] 105 | al <- sort(unique(x$aliases[[p]])) 106 | al <- if (length(al)) { 107 | grey(paste0(" [", paste(al, collapse = ", "), "]")) 108 | } else { 109 | "" 110 | } 111 | ret <- c( 112 | ret, 113 | paste0( 114 | format(counter, width = 2), " ", ct, " ", 115 | cli::style_bold(cli::col_blue(x$name[p])), 116 | al 117 | ), 118 | grey(paste0( 119 | " ", 120 | if (!is.na(rv)) rv, 121 | if (!is.na(rv) && !is.na(os)) " on ", 122 | if (!is.na(os)) os 123 | )), 124 | cli::style_italic(grey(paste0(" ", x$container[p]))) 125 | ) 126 | counter <- counter + 1L 127 | } 128 | } 129 | 130 | ret 131 | } 132 | 133 | #' @export 134 | 135 | print.rhub2_platforms <- function(x, ...) { 136 | writeLines(cli::ansi_strtrim(format(x, ...))) 137 | } 138 | 139 | #' @export 140 | 141 | `[.rhub2_platforms` <- function(x, i, j, drop = FALSE) { 142 | class(x) <- setdiff(class(x), "rhub2_platforms") 143 | NextMethod("[") 144 | } 145 | 146 | #' @export 147 | 148 | summary.rhub2_platforms <- function(object, ...) { 149 | class(object) <- c("rhub2_platforms_summary", class(object)) 150 | object 151 | } 152 | 153 | #' @export 154 | 155 | format.rhub2_platforms_summary <- function(x, ...) { 156 | num <- format(seq_len(nrow(x))) 157 | icon <- if (!has_emoji()) { 158 | ifelse(x$type == "os", "[VM]", "[CT]") 159 | } else { 160 | ifelse(x$type == "os", "\U1F5A5", "\U1F40B") 161 | } 162 | name <- cli::style_bold(cli::col_blue(x$name)) 163 | rv <- abbrev_version(x$r_version) 164 | os <- ifelse( 165 | is.na(x$os_name), 166 | paste0(x$github_os, " on GitHub"), 167 | x$os_name 168 | ) 169 | 170 | lines <- paste( 171 | ansi_align_width(num), 172 | ansi_align_width(icon), 173 | ansi_align_width(name), 174 | ansi_align_width(rv), 175 | ansi_align_width(os) 176 | ) 177 | 178 | trimws(lines, which = "right") 179 | } 180 | 181 | #' @export 182 | 183 | print.rhub2_platforms_summary <- function(x, ...) { 184 | writeLines(cli::ansi_strtrim(format(x, ...))) 185 | } 186 | 187 | abbrev_version <- function(x) { 188 | sel <- grepl("^R Under development", x) 189 | x[sel] <- sub("R Under development [(]unstable[)]", "R-devel", x[sel]) 190 | 191 | sel <- grepl("R version [0-9.]+ Patched", x) 192 | x[sel] <- sub("R version ([0-9.]+) Patched", "R-\\1 (patched)", x[sel]) 193 | 194 | sel <- grepl("R version [0-9.]+", x) 195 | x[sel] <- sub("R version ([0-9.]+)", "R-\\1", x[sel]) 196 | 197 | x[x == "*"] <- "R-* (any version)" 198 | 199 | x 200 | } 201 | -------------------------------------------------------------------------------- /R/rematch.R: -------------------------------------------------------------------------------- 1 | re_match <- function(text, pattern, perl = TRUE, ...) { 2 | 3 | stopifnot(is.character(pattern), length(pattern) == 1, !is.na(pattern)) 4 | text <- as.character(text) 5 | 6 | match <- regexpr(pattern, text, perl = perl, ...) 7 | 8 | start <- as.vector(match) 9 | length <- attr(match, "match.length") 10 | end <- start + length - 1L 11 | 12 | matchstr <- substring(text, start, end) 13 | matchstr[ start == -1 ] <- NA_character_ 14 | 15 | res <- data.frame( 16 | stringsAsFactors = FALSE, 17 | .text = text, 18 | .match = matchstr 19 | ) 20 | 21 | if (!is.null(attr(match, "capture.start"))) { 22 | 23 | gstart <- attr(match, "capture.start") 24 | glength <- attr(match, "capture.length") 25 | gend <- gstart + glength - 1L 26 | 27 | groupstr <- substring(text, gstart, gend) 28 | groupstr[ gstart == -1 ] <- NA_character_ 29 | dim(groupstr) <- dim(gstart) 30 | 31 | res <- cbind(groupstr, res, stringsAsFactors = FALSE) 32 | } 33 | 34 | names(res) <- c(attr(match, "capture.names"), ".text", ".match") 35 | res 36 | } 37 | -------------------------------------------------------------------------------- /R/setup.R: -------------------------------------------------------------------------------- 1 | 2 | check_rpkg_root <- function(rpkg_root, git_root) { 3 | if (rpkg_root != git_root) { 4 | throw(pkg_error( 5 | "R-hub currently requires that your R package is at the root of the 6 | git repository.", 7 | i = "Your R package is at {.path {rpkg_root}}.", 8 | i = "Your git repository root is at {.path {git_root}}." 9 | )) 10 | } 11 | } 12 | 13 | #' Setup the current R package for use with R-hub 14 | #' 15 | #' It adds or updates the R-hub workflow file to the current package, 16 | #' and advises on next steps. 17 | #' 18 | #' @param overwrite if `TRUE`, [rhub_setup()] will overwrite an already 19 | #' existing workflow file. 20 | #' @return Nothing. 21 | #' 22 | #' @export 23 | 24 | rhub_setup <- function(overwrite = FALSE) { 25 | cli::cli_bullets("Setting up R-hub v2.") 26 | rpkg_root <- setup_find_r_package() 27 | git_root <- setup_find_git_root() 28 | check_rpkg_root(rpkg_root, git_root) 29 | 30 | url <- "https://raw.githubusercontent.com/r-hub/rhub2/v1/inst/workflow/rhub.yaml" 31 | resp <- synchronise(http_get(url)) 32 | if (resp$status_code != 200) { 33 | throw(pkg_error( 34 | "Failed to download R-hub worflow file from GitHub.", 35 | i = "URL: {.url {url}}.", 36 | i = "HTTP status: {resp$status_code}.", 37 | i = "Make sure that you are online and GitHub is up." 38 | )) 39 | } 40 | wf <- resp$content 41 | wfc <- rawToChar(wf) 42 | Encoding(wfc) <- "UTF-8" 43 | 44 | updated <- FALSE 45 | wf_file <- file.path(git_root, ".github", "workflows", "rhub.yaml") 46 | if (file.exists(wf_file)) { 47 | wf_current <- read_file(wf_file) 48 | if (wfc != wf_current) { 49 | if (overwrite) { 50 | dir.create(dirname(wf_file), showWarnings = FALSE, recursive = TRUE) 51 | writeBin(wf, wf_file) 52 | updated <- TRUE 53 | cli::cli_bullets(c( 54 | i = "Updated existing workflow file at {.file {wf_file}}, 55 | as requested" 56 | )) 57 | } else { 58 | throw(pkg_error( 59 | "Workflow file already exists at {.file {wf_file}}.", 60 | i = "Use {.code overwrite = TRUE} for overwriting it." 61 | )) 62 | } 63 | } else { 64 | cli::cli_bullets(c( 65 | v = "Workflow file {.file {wf_file}} already exists and it is current." 66 | )) 67 | } 68 | } else { 69 | dir.create(dirname(wf_file), showWarnings = FALSE, recursive = TRUE) 70 | writeBin(wf, wf_file) 71 | updated <- TRUE 72 | cli::cli_bullets(c( 73 | v = "Created workflow file {.file {wf_file}}." 74 | )) 75 | } 76 | 77 | cli::cli_text() 78 | cli::cli_bullets(c( 79 | "Notes:", 80 | "*" = "The workflow file must be added to the {.emph default} branch 81 | of the GitHub repository.", 82 | "*" = "GitHub actions must be enabled for the repository. They are 83 | disabled for forked repositories by default." 84 | )) 85 | cli::cli_text() 86 | cli::cli_bullets(c( 87 | "Next steps:", 88 | "*" = "Add the workflow file to git using {.code git add }.", 89 | "*" = if (updated) "Commit it to git using {.code git commit}.", 90 | "*" = if (!updated) "Commit it to git using {.code git commit} (if not committed already).", 91 | "*" = if (updated) "Push the commit to GitHub using {.code git push}.", 92 | "*" = if (!updated) "Push the commit to GitHub using {.code git push} (if not pushed already).", 93 | "*" = "Call {.run rhub2::rhub_doctor()} to check that you have set up 94 | R-hub correctly.", 95 | "*" = "Call {.run rhub2::rhub_check()} to check your package." 96 | )) 97 | 98 | invisible(NULL) 99 | } 100 | 101 | setup_find_r_package <- function() { 102 | pid <- cli_status("Is the current directory part of an R package?") 103 | tryCatch( 104 | rpkg_root <- rprojroot::find_root(rprojroot::is_r_package), 105 | error = function(e) { 106 | cli::cli_status_clear(pid, result = "failed") 107 | throw(pkg_error( 108 | call. = FALSE, 109 | "The current directory is not part of an R package.", 110 | i = "You can create an R package in the current directory if you run 111 | {.run usethis::create_package('.')}.", 112 | i = "Alternatively, if you want to use R-hub for a package that is 113 | already on GitHub, supply the {.arg gh_url} argument to 114 | {.fun rhub_setup}." 115 | )) 116 | } 117 | ) 118 | cli::cli_status_clear(pid, result = "clear") 119 | cli::cli_alert_success("Found R package at {.file {rpkg_root}}.") 120 | 121 | rpkg_root 122 | } 123 | 124 | setup_find_git_root <- function() { 125 | pid <- cli_status( 126 | "Is the current directory part of a git repository?" 127 | ) 128 | tryCatch( 129 | git_root <- rprojroot::find_root(rprojroot::is_git_root), 130 | error = function(e) { 131 | cli::cli_status_clear(pid, result = "failed") 132 | throw(pkg_error( 133 | call. = FALSE, 134 | "The current R package is not in a git repository.", 135 | i = "You can create a git repository for the current package or 136 | project if you run {.run usethis::use_git()}.", 137 | i = "Alternatively, if you want to use R-hub for a package that is 138 | already on GitHub, supply the {.arg gh_url} argument to 139 | {.fun rhub_setup}." 140 | )) 141 | } 142 | ) 143 | cli::cli_status_clear(result = "clear") 144 | cli::cli_alert_success("Found git repository at {.file {git_root}}.") 145 | 146 | git_root 147 | } 148 | -------------------------------------------------------------------------------- /R/utils.R: -------------------------------------------------------------------------------- 1 | 2 | pkg_error <- function(..., .data = NULL, .class = NULL, .envir = parent.frame(), 3 | call. = TRUE) { 4 | .hide_from_trace <- TRUE 5 | cnd <- new_error( 6 | call. = call., 7 | cli::format_error( 8 | .envir = .envir, 9 | c( 10 | ... 11 | ) 12 | ) 13 | ) 14 | 15 | if (length(.data)) cnd[names(.data)] <- .data 16 | if (length(class)) class(cnd) <- c(.class, class(cnd)) 17 | 18 | cnd 19 | } 20 | 21 | stop <- function(..., call. = TRUE, domain = NA) { 22 | .hide_from_trace <- TRUE 23 | args <- list(...) 24 | if (length(args) == 1L && inherits(args[[1L]], "condition")) { 25 | throw( 26 | add_class(args[[1]], c("rlib_error_3_0", "rlib_error"), "end"), 27 | frame = parent.frame() 28 | ) 29 | } else { 30 | throw(new_error(..., call. = call., domain = domain)) 31 | } 32 | } 33 | 34 | stopifnot <- function(...) { 35 | assert_that(..., env = parent.frame()) 36 | } 37 | 38 | add_class <- function(obj, classes, where = c("start", "end")) { 39 | where <- match.arg(where) 40 | nc <- c( 41 | if (where == "start") classes, 42 | class(obj), 43 | if (where == "end") classes 44 | ) 45 | class(obj) <- unique(nc) 46 | obj 47 | } 48 | 49 | zip <- function(x, y) { 50 | mapply(FUN = c, x, y, SIMPLIFY = FALSE) 51 | } 52 | 53 | first_char <- function(x) { 54 | substr(x, 1, 1) 55 | } 56 | 57 | last_char <- function(x) { 58 | substr(x, nchar(x), nchar(x)) 59 | } 60 | 61 | unquote <- function(x) { 62 | ifelse( 63 | first_char(x) == last_char(x) & first_char(x) %in% c("'", '"'), 64 | substr(x, 2L, nchar(x) - 1L), 65 | x 66 | ) 67 | } 68 | 69 | has_emoji <- function() { 70 | if (!cli::is_utf8_output()) return(FALSE) 71 | if (isTRUE(opt <- getOption("pkg.emoji"))) return(TRUE) 72 | if (identical(opt, FALSE)) return(FALSE) 73 | if (Sys.info()[["sysname"]] != "Darwin") return(FALSE) 74 | TRUE 75 | } 76 | 77 | parse_url <- function(url) { 78 | re_url <- paste0( 79 | "^(?[a-zA-Z0-9]+)://", 80 | "(?:(?[^@/:]+)(?::(?[^@/]+))?@)?", 81 | "(?[^/]+)", 82 | "(?.*)$" # don't worry about query params here... 83 | ) 84 | 85 | mch <- re_match(url, re_url) 86 | 87 | if (is.na(mch[[1]])) { 88 | ssh_re_url <- "^git@(?[^:]+):(?.*)[.]git$" 89 | mch <- re_match(url, ssh_re_url) 90 | 91 | if (is.na(mch[[1]])) { 92 | cli::cli_abort("Invalid URL: {.url {url}}") 93 | } 94 | 95 | # Used for accessing the server's API 96 | mch$protocol <- "https" 97 | } 98 | 99 | mch[c("protocol", "host", "path")] 100 | } 101 | 102 | read_file <- function(path) { 103 | bin <- readBin(path, "raw", file.size(path)) 104 | chr <- rawToChar(bin) 105 | Encoding(chr) <- "UTF-8" 106 | chr 107 | } 108 | 109 | ansi_align_width <- function(text) { 110 | if (length(text) == 0) return(text) 111 | width <- max(cli::ansi_nchar(text, type = "width")) 112 | cli::ansi_align(text, width = width) 113 | } 114 | 115 | random_id <- function() { 116 | r <- paste0(sample(c(letters, LETTERS, 0:9), 20, replace = TRUE), collapse = "") 117 | gsub(" ", "-", cli::hash_animal(r, n_adj = 1)$hash) 118 | } 119 | 120 | readline <- function(prompt) { 121 | base::readline(prompt) 122 | } 123 | -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: 3 | github_document: 4 | toc: true 5 | toc_depth: 3 6 | includes: 7 | before_body: inst/header.md 8 | always_allow_html: yes 9 | editor_options: 10 | markdown: 11 | wrap: sentence 12 | --- 13 | 14 | ## Archived 15 | 16 | This code is now part of the [https://github.com/r-hub/rhub](rhub) package. 17 | 18 | ## License 19 | 20 | MIT © R Consortium 21 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | # rhub2 6 | 7 | > R-hub version 2 8 | 9 | 10 | [![Lifecycle: experimental](https://img.shields.io/badge/lifecycle-experimental-orange.svg)](https://lifecycle.r-lib.org/articles/stages.html#experimental) 11 | [![R-CMD-check](https://github.com/r-hub/rhub2/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/r-hub/rhub2/actions/workflows/R-CMD-check.yaml) 12 | [![](https://www.r-pkg.org/badges/version/rhub2)](https://www.r-pkg.org/pkg/rhub2) 13 | [![Codecov test coverage](https://codecov.io/gh/r-hub/rhub2/branch/main/graph/badge.svg)](https://app.codecov.io/gh/r-hub/rhub2?branch=main) 14 | 15 | 16 | R-hub 2 uses GitHub Actions to run `R CMD check` and similar package checks. 17 | The rhub2 package helps you set up R-hub 2 for your R package, and start 18 | running checks. 19 | 20 | --- 21 | 22 | - [Archived](#archived) 23 | - [License](#license) 24 | 25 | ## Archived 26 | 27 | This code is now part of the [https://github.com/r-hub/rhub](rhub) 28 | package. 29 | 30 | ## License 31 | 32 | MIT © R Consortium 33 | -------------------------------------------------------------------------------- /actions/rhub-check/action.yaml: -------------------------------------------------------------------------------- 1 | name: 'rhub-check' 2 | description: | 3 | Set up R package dependencies, and run R-hub checks. This action 4 | is deprecated in favor of `r-hub/rhub2/rhub-platform-info`, 5 | `r-hub/rhub2/rhub-setup-deps` and `r-hub/rhub2/rhub-run-check`. 6 | author: 'Gábor Csárdi' 7 | 8 | inputs: 9 | token: 10 | description: | 11 | Custom GitHub personal access token. Useful to allow access to 12 | private repositories or other resources. 13 | job-config: 14 | description: | 15 | The matrix config, as set up by the r-hub-setup action. 16 | 17 | runs: 18 | using: "composite" 19 | steps: 20 | - name: Environment variables in R 21 | run: | 22 | # 23 | cat("::group::Environment variables in R\n") 24 | Sys.getenv() 25 | cat("::endgroup::\n") 26 | shell: Rscript {0} 27 | 28 | - name: OS information 29 | run: | 30 | # 31 | cat("::group::OS information\n") 32 | if (Sys.info()[["sysname"]] == "Linux") { 33 | writeLines("-- uname -a -------------------------------------------------------------") 34 | system("uname -a") 35 | if (file.exists("/etc/os-release")) { 36 | writeLines("-- /etc/os-release ------------------------------------------------------") 37 | writeLines(readLines("/etc/os-release")) 38 | } 39 | } else if (Sys.info()[["sysname"]] == "Darwin") { 40 | writeLines("-- macOS system info ----------------------------------------------------") 41 | system("system_profiler SPSoftwareDataType SPHardwareDataType") 42 | } else if (Sys.info()[["sysname"]] == "Windows") { 43 | writeLines("-- Windows system info --------------------------------------------------") 44 | system("systeminfo") 45 | } 46 | cat("::endgroup::\n") 47 | shell: Rscript {0} 48 | 49 | - name: Compiler information 50 | run: | 51 | # 52 | cat("::group::Compiler information\n") 53 | writeLines("-- $(CC) --version ------------------------------------------------------") 54 | invisible(system(paste(system(paste0(file.path(R.home("bin"), "R"), " CMD config CC"), intern = TRUE), "--version"))) 55 | writeLines("-- $(CXX) --version ----------------------------------------------------") 56 | invisible(system(paste(system(paste0(file.path(R.home("bin"), "R"), " CMD config CXX"), intern = TRUE), "--version"))) 57 | writeLines("-- $(FC) --version ------------------------------------------------------") 58 | invisible(system(paste(system(paste0(file.path(R.home("bin"), "R"), " CMD config FC"), intern = TRUE), "--version"))) 59 | cat("::endgroup::\n") 60 | shell: Rscript {0} 61 | 62 | - name: R session information 63 | run: | 64 | # 65 | cat("::group::R session information\n") 66 | sessionInfo() 67 | cat("::endgroup::\n") 68 | shell: Rscript {0} 69 | 70 | - name: More R infomation 71 | run: | 72 | # 73 | cat("::group::More R information\n") 74 | writeLines("-- capabilities() -------------------------------------------------------") 75 | capabilities() 76 | writeLines("-- extSoftVersion() -----------------------------------------------------") 77 | extSoftVersion() 78 | writeLines("-- l10n_info() ----------------------------------------------------------") 79 | l10n_info() 80 | writeLines("-- La_version(), La_library() -------------------------------------------") 81 | La_version() 82 | La_library() 83 | writeLines("-- grSoftVersion() ------------------------------------------------------") 84 | grSoftVersion() 85 | writeLines("-- pcre_config() --------------------------------------------------------") 86 | pcre_config() 87 | writeLines("-- libcurlVersion() -----------------------------------------------------") 88 | libcurlVersion() 89 | cat("::endgroup::\n") 90 | shell: Rscript {0} 91 | 92 | - name: R CMD config 93 | run: | 94 | # 95 | cat("::group::R CMD config\n") 96 | system(paste0(file.path(R.home("bin"), "R"), " CMD config --all")) 97 | cat("::endgroup::\n") 98 | shell: Rscript {0} 99 | 100 | - name: Set user library location 101 | run: | 102 | # Set user library location 103 | cat("::group::Set user library location\n") 104 | dir.create(lib <- Sys.getenv("R_LIBS_USER"), showWarnings = FALSE, recursive = TRUE) 105 | writeLines(paste0("R_LIBS_USER=", Sys.getenv("R_LIBS_USER")), Sys.getenv("GITHUB_ENV")) 106 | cat("::endgroup::\n") 107 | shell: Rscript {0} 108 | 109 | # TODO: need to improve the cache key for R builds/packages that 110 | # - link to libc++ on Linux 111 | # - don't have an R shared library 112 | - uses: r-lib/actions/setup-r-dependencies@v2 113 | with: 114 | extra-packages: any::rcmdcheck 115 | pak-version: devel 116 | needs: check 117 | env: 118 | R_KEEP_PKG_SOURCE: yes 119 | 120 | - uses: r-lib/actions/check-r-package@v2 121 | with: 122 | args: "c('--no-manual', '--as-cran', strsplit(Sys.getenv('CHECK_ARGS'), '[ ]+')[[1]])" 123 | upload-results: false 124 | upload-snapshots: false 125 | env: 126 | R_KEEP_PKG_SOURCE: yes 127 | 128 | - name: Output 129 | if: ${{ always() }} 130 | run: | 131 | # Show output of examples and tests 132 | cat("::group::Show output of examples and tests\n") 133 | out <- dir("check", recursive=TRUE, pattern = "[.]Rout", full.names = TRUE) 134 | writeLines("-- Examples and test output ---------------------------------------------") 135 | for (of in out) { 136 | writeLines(paste0("-- ", of)) 137 | writeLines(readLines(of, warn = FALSE)) 138 | } 139 | writeLines("-------------------------------------------------------------------------") 140 | cat("::endgroup::\n") 141 | shell: Rscript {0} 142 | 143 | - name: Check for valgrind errors 144 | if: ${{ always() && matrix.config.label == 'valgrind' }} 145 | run: | 146 | # Fail for valgrind errors 147 | cat("::group::Fail for valgrind errors\n") 148 | writeLines("-- Checking for valgrind errors -----------------------------------------") 149 | out <- dir("check", recursive=TRUE, pattern = "[.]Rout", full.names = TRUE) 150 | fail <- 0 151 | for (of in out) { 152 | l <- readLines(of, warn = FALSE) 153 | if (any(grepl("==[0-9]+== ERROR SUMMARY: [1-9][0-9]* error", l))) { 154 | fail <- 1 155 | writeLines(paste0("-- ", of)) 156 | writeLines(l) 157 | } 158 | } 159 | writeLines("-------------------------------------------------------------------------") 160 | q(save = "no", status = fail) 161 | cat("::endgroup::\n") 162 | shell: Rscript {0} 163 | 164 | - uses: actions/upload-artifact@v4 165 | if: ${{ always() }} 166 | with: 167 | name: ${{ runner.os }}-${{ runner.arch }}-r${{ matrix.config.r }}-${{ github.job }}-${{ matrix.config.id || strategy.job-index }}-results 168 | path: check 169 | -------------------------------------------------------------------------------- /actions/rhub-checkout/action.yaml: -------------------------------------------------------------------------------- 1 | name: "rhub-checkout" 2 | description: | 3 | Check out a repo, a wrapper to https://github.com/actions/checkout. 4 | author: 'Gábor Csárdi' 5 | 6 | inputs: 7 | repository: 8 | description: > 9 | Repository name with owner. For example, actions/checkout. 10 | default: ${{ github.repository }} 11 | ref: 12 | description: > 13 | The branch, tag or SHA to checkout. When checking out the repository that 14 | triggered a workflow, this defaults to the reference or SHA for that 15 | event. Otherwise, uses the default branch. 16 | 17 | runs: 18 | using: "composite" 19 | steps: 20 | - uses: actions/checkout@v4 21 | with: 22 | repository: ${{ inputs.repository }} 23 | ref: ${{ inputs.ref }} 24 | -------------------------------------------------------------------------------- /actions/rhub-platform-info/action.yaml: -------------------------------------------------------------------------------- 1 | name: 'rhub-platform-info' 2 | description: | 3 | R platform information. 4 | author: 'Gábor Csárdi' 5 | 6 | inputs: 7 | token: 8 | description: | 9 | Custom GitHub personal access token. Useful to allow access to 10 | private repositories or other resources. 11 | job-config: 12 | description: | 13 | The matrix config, as set up by the r-hub-setup action. 14 | 15 | runs: 16 | using: "composite" 17 | steps: 18 | - name: R Options 19 | run: | 20 | # 21 | cat("::group::R Options\n") 22 | options() 23 | cat("::endgroup::\n") 24 | shell: Rscript {0} 25 | 26 | - name: Environment variables in R 27 | run: | 28 | # 29 | cat("::group::Environment variables in R\n") 30 | Sys.getenv() 31 | cat("::endgroup::\n") 32 | shell: Rscript {0} 33 | 34 | - name: OS information 35 | run: | 36 | # 37 | cat("::group::OS information\n") 38 | if (Sys.info()[["sysname"]] == "Linux") { 39 | writeLines("-- uname -a -------------------------------------------------------------") 40 | system("uname -a") 41 | if (file.exists("/etc/os-release")) { 42 | writeLines("-- /etc/os-release ------------------------------------------------------") 43 | writeLines(readLines("/etc/os-release")) 44 | } 45 | } else if (Sys.info()[["sysname"]] == "Darwin") { 46 | writeLines("-- macOS system info ----------------------------------------------------") 47 | system("system_profiler SPSoftwareDataType SPHardwareDataType") 48 | } else if (Sys.info()[["sysname"]] == "Windows") { 49 | writeLines("-- Windows system info --------------------------------------------------") 50 | system("systeminfo") 51 | } 52 | cat("::endgroup::\n") 53 | shell: Rscript {0} 54 | 55 | - name: Compiler information 56 | run: | 57 | # 58 | cat("::group::Compiler information\n") 59 | writeLines("-- $(CC) --version ------------------------------------------------------") 60 | invisible(system(paste(system(paste0(file.path(R.home("bin"), "R"), " CMD config CC"), intern = TRUE), "--version"))) 61 | writeLines("-- $(CXX) --version ----------------------------------------------------") 62 | invisible(system(paste(system(paste0(file.path(R.home("bin"), "R"), " CMD config CXX"), intern = TRUE), "--version"))) 63 | writeLines("-- $(FC) --version ------------------------------------------------------") 64 | invisible(system(paste(system(paste0(file.path(R.home("bin"), "R"), " CMD config FC"), intern = TRUE), "--version"))) 65 | cat("::endgroup::\n") 66 | shell: Rscript {0} 67 | 68 | - name: R session information 69 | run: | 70 | # 71 | cat("::group::R session information\n") 72 | sessionInfo() 73 | cat("::endgroup::\n") 74 | shell: Rscript {0} 75 | 76 | - name: More R infomation 77 | run: | 78 | # 79 | cat("::group::More R information\n") 80 | writeLines("-- capabilities() -------------------------------------------------------") 81 | capabilities() 82 | writeLines("-- extSoftVersion() -----------------------------------------------------") 83 | extSoftVersion() 84 | writeLines("-- l10n_info() ----------------------------------------------------------") 85 | l10n_info() 86 | writeLines("-- La_version(), La_library() -------------------------------------------") 87 | La_version() 88 | La_library() 89 | writeLines("-- grSoftVersion() ------------------------------------------------------") 90 | grSoftVersion() 91 | writeLines("-- pcre_config() --------------------------------------------------------") 92 | pcre_config() 93 | writeLines("-- libcurlVersion() -----------------------------------------------------") 94 | libcurlVersion() 95 | cat("::endgroup::\n") 96 | shell: Rscript {0} 97 | 98 | - name: R CMD config 99 | run: | 100 | # 101 | cat("::group::R CMD config\n") 102 | system(paste0(file.path(R.home("bin"), "R"), " CMD config --all")) 103 | cat("::endgroup::\n") 104 | shell: Rscript {0} 105 | -------------------------------------------------------------------------------- /actions/rhub-run-check/action.yaml: -------------------------------------------------------------------------------- 1 | name: 'rhub-run-check' 2 | description: | 3 | Run R-hub checks. 4 | author: 'Gábor Csárdi' 5 | 6 | inputs: 7 | token: 8 | description: | 9 | Custom GitHub personal access token. Useful to allow access to 10 | private repositories or other resources. 11 | job-config: 12 | description: | 13 | The matrix config, as set up by the r-hub-setup action. 14 | remove-dot-github: 15 | description: | 16 | Whether to delete `.github` directory before the check. This is 17 | usually not a good idea, but R-hub needs to do it when running on 18 | a package submitted to the RC cluster. 19 | default: false 20 | 21 | runs: 22 | using: "composite" 23 | steps: 24 | - name: Remove .github 25 | if: ${{ inputs.remove-dot-github == 'true' }} 26 | run: | 27 | unlink(".github", force = TRUE, recursive = TRUE) 28 | shell: Rscript {0} 29 | 30 | - uses: r-lib/actions/check-r-package@v2-branch 31 | with: 32 | args: "c('--no-manual', if (!grepl('(^| )[-][-]extra[-]arch( |$)', Sys.getenv('CHECK_ARGS'))) '--as-cran', '--install-args=--build', strsplit(Sys.getenv('CHECK_ARGS'), '[ ]+')[[1]])" 33 | build_args: "c('--no-manual', strsplit(Sys.getenv('BUILD_ARGS'), '[ ]+')[[1]])" 34 | upload-results: never 35 | upload-snapshots: false 36 | env: 37 | R_KEEP_PKG_SOURCE: yes 38 | 39 | - name: Output 40 | if: ${{ always() }} 41 | run: | 42 | # Show output of installation, examples and tests 43 | cat("::group::Show installation output\n") 44 | out <- dir("check", recursive=TRUE, pattern = "00install.out", full.names = TRUE) 45 | if (length(out) > 0) { 46 | for (of in out) { 47 | writeLines(readLines(of)) 48 | } 49 | } 50 | cat("::endgroup::\n") 51 | cat("::group::Show output of examples and tests\n") 52 | out <- dir("check", recursive=TRUE, pattern = "[.]Rout", full.names = TRUE) 53 | writeLines("-- Examples and test output ---------------------------------------------") 54 | for (of in out) { 55 | writeLines(paste0("-- ", of)) 56 | writeLines(readLines(of, warn = FALSE)) 57 | } 58 | writeLines("-------------------------------------------------------------------------") 59 | cat("::endgroup::\n") 60 | shell: Rscript {0} 61 | 62 | - name: Check for valgrind errors 63 | if: ${{ always() && matrix.config.label == 'valgrind' }} 64 | run: | 65 | # Fail for valgrind errors 66 | cat("::group::Fail for valgrind errors\n") 67 | writeLines("-- Checking for valgrind errors -----------------------------------------") 68 | out <- dir("check", recursive=TRUE, pattern = "[.]Rout", full.names = TRUE) 69 | fail <- 0 70 | for (of in out) { 71 | l <- readLines(of, warn = FALSE) 72 | if (any(grepl("==[0-9]+== ERROR SUMMARY: [1-9][0-9]* error", l))) { 73 | fail <- 1 74 | writeLines(paste0("-- ", of)) 75 | writeLines(l) 76 | } 77 | } 78 | writeLines("-------------------------------------------------------------------------") 79 | q(save = "no", status = fail) 80 | cat("::endgroup::\n") 81 | shell: Rscript {0} 82 | 83 | - name: Save binary package 84 | if: ${{ always() }} 85 | run: | 86 | # Save binary package 87 | cat("::group::Save binary package\n") 88 | out <- dir("check", recursive=TRUE, pattern = "00install.out", full.names = TRUE) 89 | if (length(out) > 0) { 90 | lns <- readLines(out[1]) 91 | pkgline <- grep("^packaged installation", lns, value = TRUE) 92 | if (length(pkgline) > 0) { 93 | pkg <- sub("['’].*$", "", sub("^.*as ['‘]", "", pkgline)) 94 | if (file.copy(pkg, "check")) { 95 | message("Copied binary package '", pkg, "' to check/") 96 | } else { 97 | warning("Could not copy binary package '", pkg, "' to check/") 98 | } 99 | } else { 100 | warning("Could not find binary package.") 101 | } 102 | } else { 103 | warning("Could not find binary package.") 104 | } 105 | cat("::endgroup::\n") 106 | shell: Rscript {0} 107 | 108 | - uses: actions/upload-artifact@v4 109 | if: ${{ always() }} 110 | with: 111 | name: ${{ matrix.config.label }}-${{ github.job }}-${{ matrix.config.id || strategy.job-index }}-results 112 | path: check 113 | -------------------------------------------------------------------------------- /actions/rhub-setup-deps/action.yaml: -------------------------------------------------------------------------------- 1 | name: rhub-setup-check 2 | description: | 3 | Set up dependencies for R-hub checks. 4 | author: 'Gábor Csárdi' 5 | 6 | inputs: 7 | token: 8 | description: | 9 | Custom GitHub personal access token. Useful to allow access to 10 | private repositories or other resources. 11 | job-config: 12 | description: | 13 | The matrix config, as set up by the r-hub-setup action. 14 | extra-packages: 15 | description: | 16 | Any extra packages to install outside of the packages listed in the 17 | dependencies. 18 | default: any::rcmdcheck 19 | needs: 20 | description: | 21 | Any extra Config/Needs fields which need to be included when 22 | installing dependencies. 23 | default: check 24 | pak-version: 25 | description: | 26 | Which pak version to use. Possible values are "stable", "rc" and 27 | "devel". 28 | default: stable 29 | dependencies: 30 | description: | 31 | Types of dependencies to install. Must be an R expression. Note that 32 | it often needs to be quoted in YAML, see the README for details. 33 | default: '"all"' 34 | 35 | runs: 36 | using: "composite" 37 | steps: 38 | - name: Set user library location 39 | run: | 40 | # Set user library location 41 | cat("::group::Set user library location\n") 42 | dir.create(lib <- Sys.getenv("R_LIBS_USER"), showWarnings = FALSE, recursive = TRUE) 43 | writeLines(paste0("R_LIBS_USER=", Sys.getenv("R_LIBS_USER")), Sys.getenv("GITHUB_ENV")) 44 | cat("::endgroup::\n") 45 | shell: Rscript {0} 46 | 47 | # TODO: need to improve the cache key for R builds/packages that 48 | # - link to libc++ on Linux 49 | # - don't have an R shared library 50 | - uses: r-lib/actions/setup-r-dependencies@v2 51 | with: 52 | extra-packages: ${{ inputs.extra-packages }} 53 | needs: ${{ inputs.needs }} 54 | pak-version: ${{ inputs.pak-version }} 55 | dependencies: ${{ inputs.dependencies }} 56 | env: 57 | R_KEEP_PKG_SOURCE: yes 58 | -------------------------------------------------------------------------------- /actions/rhub-setup-r/action.yaml: -------------------------------------------------------------------------------- 1 | name: 'rhub-setup-r' 2 | description: | 3 | Install and setup R for R-hub jobs. 4 | author: 'Gábor Csárdi' 5 | 6 | inputs: 7 | job-config: 8 | description: | 9 | The matrix config, as set up by the r-hub-setup action. 10 | token: 11 | description: | 12 | Custom GitHub personal access token. Useful to allow access to 13 | private repositories or other resources. 14 | 15 | runs: 16 | using: "composite" 17 | steps: 18 | - uses: r-lib/actions/setup-r@v2 19 | with: 20 | r-version: ${{ fromJson(inputs.job-config).r-version }} 21 | use-public-rspm: true 22 | - name: Set up R-hub repository 23 | run: | 24 | # 25 | source("set-rhub-repos.R") 26 | main() 27 | shell: Rscript {0} 28 | working-directory: ${{github.action_path}} 29 | -------------------------------------------------------------------------------- /actions/rhub-setup-r/set-rhub-repos.R: -------------------------------------------------------------------------------- 1 | strict_mode <- function() { 2 | options( 3 | useFancyQuotes = FALSE, 4 | warn = 2, 5 | warnPartialMatchArgs = TRUE, 6 | warnPartialMatchAttr = TRUE, 7 | warnPartialMatchDollar = TRUE 8 | ) 9 | } 10 | 11 | no_repos <- function() { 12 | message( 13 | "No extra repositoes for R ", getRversion(), 14 | " on ", Sys.info()[["sysname"]], 15 | " (", Sys.info()[["machine"]], 16 | ") currently." 17 | ) 18 | } 19 | 20 | set_repos_unknown <- function() { 21 | message("No extra repositories for ", Sys.info()[["sysname"]], " systems.") 22 | } 23 | 24 | set_repos_windows <- function() { 25 | no_repos() 26 | } 27 | 28 | no_repos_unknown_linux <- function() { 29 | message("No extra repositories for unknown Linux systems.") 30 | } 31 | 32 | set_repos_linux <- function() { 33 | if (!file.exists("/etc/os-release")) { 34 | return(no_repos_unknown_linux()) 35 | } 36 | ok <- tryCatch( 37 | readRenviron("/etc/os-release"), 38 | error = function(e) "nope" 39 | ) 40 | if (identical(ok, "nope")) { 41 | return(no_repos_unknown_linux()) 42 | } 43 | 44 | id <- Sys.getenv("ID") 45 | ver <- Sys.getenv("VERSION_ID") 46 | 47 | if (id != "ubuntu" || ver != "22.04") { 48 | message("No extra repositories for ", id, " ", ver, " Linux systems.") 49 | return() 50 | } 51 | 52 | arch <- Sys.info()[["machine"]] 53 | if (arch != "x86_64") { 54 | return(no_repos()) 55 | } 56 | rver <- getRversion() 57 | if (rver < "4.4.0" || rver >= "4.5.0") { 58 | return(no_repos()) 59 | } 60 | 61 | add_repo(c(RHUB = "https://raw.githubusercontent.com/r-hub/repos/main/ubuntu-22.04/4.4")) 62 | } 63 | 64 | set_repos_macos <- function() { 65 | rver <- getRversion() 66 | if (rver < "4.4.0" || rver >= "4.5.0") { 67 | return(no_repos()) 68 | } 69 | arch <- Sys.info()[["machine"]] 70 | if (arch == "x86_64") { 71 | add_repo(c(RHUB = "https://raw.githubusercontent.com/r-hub/repos/main/macos-x86_64/4.4/")) 72 | } else { 73 | add_repo(c(RHUB = "https://raw.githubusercontent.com/r-hub/repos/main/macos-arm64/4.4/")) 74 | } 75 | } 76 | 77 | add_repo <- function(repo) { 78 | for (i in seq_along(repo)) { 79 | message("Adding repository ", names(repo)[i], " = ", repo[i], ".") 80 | cat( 81 | append = TRUE, sep = "\n", file = "~/.Rprofile", 82 | sprintf("options(repos = c(%s = \"%s\", getOption(\"repos\")))", names(repo)[i], repo[i]) 83 | ) 84 | } 85 | } 86 | 87 | set_repos <- function() { 88 | sysname <- Sys.info()[["sysname"]] 89 | switch( 90 | sysname, 91 | "Linux" = set_repos_linux(), 92 | "Darwin" = set_repos_macos(), 93 | "Windows" = set_repos_windows(), 94 | set_repos_unknown() 95 | ) 96 | } 97 | 98 | main <- function() { 99 | strict_mode() 100 | set_repos() 101 | } 102 | 103 | if (is.null(sys.calls())) { 104 | main() 105 | } 106 | -------------------------------------------------------------------------------- /actions/rhub-setup/Makefile: -------------------------------------------------------------------------------- 1 | 2 | test: 3 | NOT_CRAN=true R -q -e 'testthat::test_file("platforms.R")' 4 | 5 | snapshot-review: 6 | R -q -e 'testthat::snapshot_review(path = ".")' 7 | -------------------------------------------------------------------------------- /actions/rhub-setup/_snaps/platforms.md: -------------------------------------------------------------------------------- 1 | # to_json 2 | 3 | Code 4 | to_json(1) 5 | Output 6 | [1] "1" 7 | Code 8 | to_json(1:4) 9 | Output 10 | [1] "[1,2,3,4]" 11 | Code 12 | to_json(FALSE) 13 | Output 14 | [1] "false" 15 | 16 | -------------------------------------------------------------------------------- /actions/rhub-setup/action.yaml: -------------------------------------------------------------------------------- 1 | name: 'rhub-setup' 2 | description: | 3 | Setup platform matrices to run R-hub jobs. 4 | author: 'Gábor Csárdi' 5 | 6 | inputs: 7 | config: 8 | description: | 9 | R-hub configuration. A JSON string, see documentation for details. 10 | 11 | outputs: 12 | containers: 13 | description: 'Container platforms.' 14 | value: ${{ steps.config.outputs.containers }} 15 | platforms: 16 | description: 'Other R-hub platforms.' 17 | value: ${{ steps.config.outputs.platforms }} 18 | 19 | runs: 20 | using: "composite" 21 | steps: 22 | - name: Configure R-hub platforms 23 | id: config 24 | run: | 25 | cd ${{github.action_path}} 26 | cnt=$(R -s -f platforms.R --args --containers '${{ inputs.config }}') 27 | echo "Containers:" 28 | echo "$cnt" | jq 29 | echo "containers=$cnt" >> $GITHUB_OUTPUT 30 | plt=$(R -s -f platforms.R --args --not-containers '${{ inputs.config }}') 31 | echo "Other platforms:" 32 | echo "$plt" | jq 33 | echo "platforms=$plt" >> $GITHUB_OUTPUT 34 | shell: bash 35 | -------------------------------------------------------------------------------- /actions/rhub-setup/json.R: -------------------------------------------------------------------------------- 1 | 2 | # Standalone JSON parser 3 | # 4 | # The purpose of this file is to provide a standalone JSON parser. 5 | # It is quite slow and bare. If you need a proper parser please use the 6 | # jsonlite package. 7 | # 8 | # The canonical location of this file is in the remotes package: 9 | # https://github.com/r-lib/remotes/blob/HEAD/R/json.R 10 | # 11 | # API: 12 | # parse(text) 13 | # parse_file(filename) 14 | # 15 | # NEWS: 16 | # - 2019/05/15 First standalone version 17 | 18 | json <- local({ 19 | 20 | tokenize_json <- function(text) { 21 | text <- paste(text, collapse = "\n") 22 | 23 | ESCAPE <- '(\\\\[^u[:cntrl:]]|\\\\u[0-9a-fA-F]{4})' 24 | CHAR <- '[^[:cntrl:]"\\\\]' 25 | 26 | STRING <- paste0('"', CHAR, '*(', ESCAPE, CHAR, '*)*"') 27 | NUMBER <- "-?(0|[1-9][0-9]*)([.][0-9]*)?([eE][+-]?[0-9]*)?" 28 | KEYWORD <- 'null|false|true' 29 | SPACE <- '[[:space:]]+' 30 | 31 | match <- gregexpr( 32 | pattern = paste0( 33 | STRING, "|", NUMBER, "|", KEYWORD, "|", SPACE, "|", "." 34 | ), 35 | text = text, 36 | perl = TRUE 37 | ) 38 | 39 | grep("^\\s+$", regmatches(text, match)[[1]], value = TRUE, invert = TRUE) 40 | } 41 | 42 | throw <- function(...) { 43 | stop("JSON: ", ..., call. = FALSE) 44 | } 45 | 46 | # Parse a JSON file 47 | # 48 | # @param filename Path to the JSON file. 49 | # @return R objects corresponding to the JSON file. 50 | 51 | parse_file <- function(filename) { 52 | parse(readLines(filename, warn = FALSE)) 53 | } 54 | 55 | # Parse a JSON string 56 | # 57 | # @param text JSON string. 58 | # @return R object corresponding to the JSON string. 59 | 60 | parse <- function(text) { 61 | 62 | tokens <- tokenize_json(text) 63 | token <- NULL 64 | ptr <- 1 65 | 66 | read_token <- function() { 67 | if (ptr <= length(tokens)) { 68 | token <<- tokens[ptr] 69 | ptr <<- ptr + 1 70 | } else { 71 | token <<- 'EOF' 72 | } 73 | } 74 | 75 | parse_value <- function(name = "") { 76 | if (token == "{") { 77 | parse_object() 78 | } else if (token == "[") { 79 | parse_array() 80 | } else if (token == "EOF" || (nchar(token) == 1 && ! token %in% 0:9)) { 81 | throw("EXPECTED value GOT ", token) 82 | } else { 83 | j2r(token) 84 | } 85 | } 86 | 87 | parse_object <- function() { 88 | res <- structure(list(), names = character()) 89 | 90 | read_token() 91 | 92 | ## Invariant: we are at the beginning of an element 93 | while (token != "}") { 94 | 95 | ## "key" 96 | if (grepl('^".*"$', token)) { 97 | key <- j2r(token) 98 | } else { 99 | throw("EXPECTED string GOT ", token) 100 | } 101 | 102 | ## : 103 | read_token() 104 | if (token != ":") { throw("EXPECTED : GOT ", token) } 105 | 106 | ## value 107 | read_token() 108 | res[key] <- list(parse_value()) 109 | 110 | ## } or , 111 | read_token() 112 | if (token == "}") { 113 | break 114 | } else if (token != ",") { 115 | throw("EXPECTED , or } GOT ", token) 116 | } 117 | read_token() 118 | } 119 | 120 | res 121 | } 122 | 123 | parse_array <- function() { 124 | res <- list() 125 | 126 | read_token() 127 | 128 | ## Invariant: we are at the beginning of an element 129 | while (token != "]") { 130 | ## value 131 | res <- c(res, list(parse_value())) 132 | 133 | ## ] or , 134 | read_token() 135 | if (token == "]") { 136 | break 137 | } else if (token != ",") { 138 | throw("EXPECTED , GOT ", token) 139 | } 140 | read_token() 141 | } 142 | 143 | res 144 | } 145 | 146 | read_token() 147 | parse_value(tokens) 148 | } 149 | 150 | j2r <- function(token) { 151 | if (token == "null") { 152 | NULL 153 | } else if (token == "true") { 154 | TRUE 155 | } else if (token == "false") { 156 | FALSE 157 | } else if (grepl('^".*"$', token)) { 158 | trimq(token) 159 | } else { 160 | as.numeric(token) 161 | } 162 | } 163 | 164 | trimq <- function(x) { 165 | sub('^"(.*)"$', "\\1", x) 166 | } 167 | 168 | structure( 169 | list( 170 | .internal = environment(), 171 | parse = parse, 172 | parse_file = parse_file 173 | ), 174 | class = c("standalone_json", "standalone")) 175 | }) 176 | -------------------------------------------------------------------------------- /actions/rhub-setup/platforms.R: -------------------------------------------------------------------------------- 1 | 2 | strict_mode <- function() { 3 | options( 4 | useFancyQuotes = FALSE, 5 | warn = 2, 6 | warnPartialMatchArgs = TRUE, 7 | warnPartialMatchAttr = TRUE, 8 | warnPartialMatchDollar = TRUE 9 | ) 10 | } 11 | 12 | get_platforms <- function() { 13 | source("json.R") 14 | json[["parse_file"]]("platforms.json") 15 | } 16 | 17 | parse_args <- function(args) { 18 | source("json.R") 19 | containers <- "--containers" %in% args 20 | platforms <- "--not-containers" %in% args 21 | if (containers + platforms != 1) { 22 | stop("Needs exactly one of `--containers` and `--not-containers`") 23 | } 24 | args <- setdiff(args, c("--containers", "--not-containers")) 25 | if (length(args) == 0) { 26 | stop("No configuration argument") 27 | } 28 | if (length(args) > 1) { 29 | stop("Needs exactly one configuration argument") 30 | } 31 | 32 | config <- tryCatch( 33 | json[["parse"]](args), 34 | error = function(e) { 35 | list(platforms = trimws(strsplit(args, ",")[[1]])) 36 | } 37 | ) 38 | 39 | list(config = config, containers = containers, platforms = platforms) 40 | } 41 | 42 | match_r_version <- function(p) { 43 | if (p[["r-version"]] != "default") { 44 | p[["r-version"]] 45 | } else if (startsWith(p$name, "r-devel-")) { 46 | "devel" 47 | } else if (startsWith(p$name, "r-patched-")) { 48 | "next" 49 | } else if (startsWith(p$name, "r-release-")) { 50 | "release" 51 | } else if (startsWith(p$name, "r-oldrel-")) { 52 | "oldrel" 53 | } else { 54 | "devel" 55 | } 56 | } 57 | 58 | match_platforms <- function(config) { 59 | platforms <- get_platforms() 60 | cnt <- plt <- list() 61 | for (p in config$platforms) { 62 | 63 | # Allow a simple character form specifying a platform or alias 64 | if (is.character(p)) { 65 | p <- list(name = p, "r-version" = "default") 66 | } 67 | done <- FALSE 68 | 69 | # Collect **all** matching platforms 70 | for (np in platforms) { 71 | if (p$name %in% c(np[["name"]], np[["cran-names"]], np[["aliases"]])) { 72 | done <- TRUE 73 | np[["label"]] <- if (np[["name"]] != p[["name"]]) { 74 | paste0(np[["name"]], " (", p[["name"]], ")") 75 | } else { 76 | np[["name"]] 77 | } 78 | if (!is.null(np[["r-version"]]) && np[["r-version"]] == "*") { 79 | np[["r-version"]] <- match_r_version(p) 80 | np[["label"]] <- paste0(np[["label"]], " (R-", np[["r-version"]], ")") 81 | } 82 | if (np[["type"]] == "container") { 83 | cnt <- c(cnt, list(np)) 84 | } else { 85 | plt <- c(plt, list(np)) 86 | } 87 | } 88 | } 89 | if (!done) { 90 | stop("Unknown R-hub platform: ", p$name) 91 | } 92 | } 93 | 94 | cnt <- unique(cnt) 95 | plt <- unique(plt) 96 | cnt <- lapply(cnt, "[", c("label", "name", "container")) 97 | plt <- lapply(plt, "[", c("label", "name", "os", "r-version")) 98 | 99 | for (i in seq_along(cnt)) { 100 | cnt[[i]]$`job-config` <- to_json(cnt[[i]]) 101 | } 102 | for (i in seq_along(plt)) { 103 | plt[[i]]$`job-config` <- to_json(plt[[i]]) 104 | } 105 | 106 | list(containers = unname(cnt), platforms = unname(plt)) 107 | } 108 | 109 | vcapply <- function(X, FUN, ...) { 110 | vapply(X, FUN, FUN.VALUE = character(1), ...) 111 | } 112 | 113 | to_json <- function(x) { 114 | 115 | no_na <- function(x) { 116 | if (anyNA(x)) { 117 | stop("`NA` values are not allowed when converting config to JSON.") 118 | } 119 | x 120 | } 121 | 122 | esc <- function(x) { 123 | x <- gsub("\\", "\\\\", x, fixed = TRUE) 124 | x <- gsub("\"", "\\\"", x, fixed = TRUE) 125 | x 126 | } 127 | 128 | is_named <- function(x) { 129 | if (is.null(names(x))) { 130 | return(FALSE) 131 | } 132 | if (any(names(x) == "")) { 133 | stop("All elements of lists must be named when converting to JSON") 134 | } 135 | if (any(duplicated(names(x)))) { 136 | stop("Duplicate names in lists are not allowed when converting to JSON") 137 | } 138 | TRUE 139 | } 140 | 141 | tx <- typeof(x) 142 | switch( 143 | tx, 144 | "NULL" = "null", 145 | "logical" = , 146 | "integer" = , 147 | "double" = { 148 | paste0( 149 | if (length(x) != 1) "[", 150 | tolower(paste(no_na(x), collapse = ",")), 151 | if (length(x) != 1) "]" 152 | ) 153 | }, 154 | "character" = { 155 | paste0( 156 | if (length(x) != 1) "[", 157 | paste0('"', esc(no_na(x)), '"', collapse = ","), 158 | if (length(x) != 1) "]" 159 | ) 160 | }, 161 | "list" = { 162 | if (is_named(x)) { 163 | paste0( 164 | "{", 165 | paste0('"', names(x), "\":", vcapply(x, to_json), collapse = ","), 166 | "}" 167 | ) 168 | }else { 169 | paste0( 170 | "[", 171 | paste0(vcapply(x, to_json), collapse = ","), 172 | "]" 173 | ) 174 | } 175 | }, 176 | stop("Cannot convert a ", tx, " object to JSON.") 177 | ) 178 | } 179 | 180 | main <- function() { 181 | strict_mode() 182 | args <- parse_args(commandArgs(TRUE)) 183 | run <- match_platforms(args$config) 184 | if (args$containers) { 185 | writeLines(to_json(run$containers)) 186 | } else if (args$platforms) { 187 | writeLines(to_json(run$platforms)) 188 | } 189 | } 190 | 191 | if (is.null(sys.calls())) { 192 | main() 193 | } 194 | 195 | # ------------------------------------------------------------------------- 196 | 197 | if (Sys.getenv("TESTTHAT") == "") { 198 | test_that <- function(...) invisible() 199 | } 200 | 201 | test_that("to_json", { 202 | expect_snapshot({ 203 | to_json(1) 204 | to_json(1:4) 205 | to_json(FALSE) 206 | }) 207 | }) 208 | -------------------------------------------------------------------------------- /actions/rhub-setup/platforms.json: -------------------------------------------------------------------------------- 1 | [ 2 | { 3 | "name": "ubuntu-clang", 4 | "cran-names": ["r-devel-linux-x86_64-debian-clang"], 5 | "aliases": ["r-devel-linux-x86_64-debian-clang"], 6 | "type": "container", 7 | "os-type": "Linux", 8 | "container": "ghcr.io/r-hub/containers/ubuntu-clang:latest" 9 | }, 10 | 11 | { 12 | "name": "ubuntu-gcc12", 13 | "cran-names": ["r-devel-linux-x86_64-debian-gcc"], 14 | "aliases": ["r-devel-linux-x86_64-debian-gcc"], 15 | "type": "container", 16 | "os-type": "Linux", 17 | "container": "ghcr.io/r-hub/containers/ubuntu-gcc12:latest" 18 | }, 19 | 20 | { 21 | "name": "ubuntu-next", 22 | "cran-names": ["r-patched-linux-x86_64"], 23 | "aliases": ["r-patched-linux-x86_64", "r-patched", "r-next"], 24 | "type": "container", 25 | "os-type": "Linux", 26 | "container": "ghcr.io/r-hub/containers/ubuntu-next:latest" 27 | }, 28 | 29 | { 30 | "name": "ubuntu-release", 31 | "cran-names": ["r-release-linux-x86_64"], 32 | "aliases": ["r-release-linux-x86_64", "ubuntu", "r-release"], 33 | "type": "container", 34 | "os-type": "Linux", 35 | "container": "ghcr.io/r-hub/containers/ubuntu-release:latest" 36 | }, 37 | 38 | { 39 | "name": "atlas", 40 | "cran-names": ["ATLAS"], 41 | "aliases": [], 42 | "type": "container", 43 | "os-type": "Linux", 44 | "container": "ghcr.io/r-hub/containers/atlas:latest" 45 | }, 46 | 47 | { 48 | "name": "clang-asan", 49 | "cran-names": ["clang-ASAN", "clang-UBSAN"], 50 | "aliases": ["asan", "ubsan"], 51 | "type": "container", 52 | "os-type": "Linux", 53 | "container": "ghcr.io/r-hub/containers/clang-asan:latest" 54 | }, 55 | 56 | { 57 | "name": "clang16", 58 | "cran-names": ["clang16"], 59 | "aliases": [], 60 | "type": "container", 61 | "os-type": "Linux", 62 | "container": "ghcr.io/r-hub/containers/clang16:latest" 63 | }, 64 | 65 | { 66 | "name": "clang17", 67 | "cran-names": ["clang17"], 68 | "aliases": [], 69 | "type": "container", 70 | "os-type": "Linux", 71 | "container": "ghcr.io/r-hub/containers/clang17:latest" 72 | }, 73 | 74 | { 75 | "name": "clang18", 76 | "cran-names": ["clang18"], 77 | "aliases": [], 78 | "type": "container", 79 | "os-type": "Linux", 80 | "container": "ghcr.io/r-hub/containers/clang18:latest" 81 | }, 82 | 83 | { 84 | "name": "gcc13", 85 | "cran-names": ["gcc13"], 86 | "aliases": [], 87 | "type": "container", 88 | "os-type": "Linux", 89 | "container": "ghcr.io/r-hub/containers/gcc13:latest" 90 | }, 91 | 92 | { 93 | "name": "nold", 94 | "cran-names": ["noLD"], 95 | "aliases": [], 96 | "type": "container", 97 | "os-type": "Linux", 98 | "container": "ghcr.io/r-hub/containers/nold:latest" 99 | }, 100 | 101 | { 102 | "name": "valgrind", 103 | "cran-names": ["valgrind"], 104 | "aliases": [], 105 | "type": "container", 106 | "os-type": "Linux", 107 | "container": "ghcr.io/r-hub/containers/valgrind:latest" 108 | }, 109 | 110 | { 111 | "name": "mkl", 112 | "cran-names": ["MKL"], 113 | "aliases": [], 114 | "type": "container", 115 | "os-type": "Linux", 116 | "container": "ghcr.io/r-hub/containers/mkl:latest" 117 | }, 118 | 119 | { 120 | "name": "intel", 121 | "cran-names": ["Intel"], 122 | "aliases": [], 123 | "type": "container", 124 | "os-type": "Linux", 125 | "container": "ghcr.io/r-hub/containers/intel:latest" 126 | }, 127 | 128 | { 129 | "name": "donttest", 130 | "cran-names": ["donttest"], 131 | "aliases": [], 132 | "type": "container", 133 | "os-type": "Linux", 134 | "container": "ghcr.io/r-hub/containers/donttest:latest" 135 | }, 136 | 137 | { 138 | "name": "nosuggests", 139 | "cran-names": ["noSuggests"], 140 | "aliases": [], 141 | "type": "container", 142 | "os-type": "Linux", 143 | "container": "ghcr.io/r-hub/containers/nosuggests:latest" 144 | }, 145 | 146 | { 147 | "name": "windows", 148 | "cran-names": [ 149 | "r-devel-windows-x86_64", 150 | "r-release-windows-x86_64", 151 | "r-oldrel-windows-x86_64" 152 | ], 153 | "aliases": [ 154 | "r-devel-windows", 155 | "r-release-windows", 156 | "r-oldrel-windows" 157 | ], 158 | "type": "os", 159 | "os-type": "Windows", 160 | "os": "windows-latest", 161 | "r-version": "*" 162 | }, 163 | 164 | { 165 | "name": "macos", 166 | "cran-names": [ 167 | "r-release-macos-x86_64", 168 | "r-oldrel-macos-x86_64" 169 | ], 170 | "aliases": [ 171 | "macos-x86_64", 172 | "r-release-macos", 173 | "r-oldrel-macos", 174 | "r-release-macos-x86_64", 175 | "r-oldrel-macos-x86_64" 176 | ], 177 | "type": "os", 178 | "os-type": "macOS", 179 | "os": "macos-latest", 180 | "arch": "x86_64", 181 | "r-version": "*" 182 | }, 183 | 184 | { 185 | "name": "macos-arm64", 186 | "cran-names": [ 187 | "r-release-macos-arm64", 188 | "r-oldrel-macos-arm64" 189 | ], 190 | "aliases": [], 191 | "type": "os", 192 | "os-type": "macOS", 193 | "os": "macos-14", 194 | "arch": "arm64", 195 | "r-version": "*" 196 | }, 197 | 198 | { 199 | "name": "linux", 200 | "cran-names": [], 201 | "aliases": [], 202 | "type": "os", 203 | "os-type": "Linux", 204 | "os": "ubuntu-latest", 205 | "arch": "x86_64", 206 | "r-version": "*" 207 | } 208 | ] 209 | -------------------------------------------------------------------------------- /inst/header.md: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | # rhub2 5 | 6 | > R-hub version 2 7 | 8 | 9 | [![Lifecycle: experimental](https://img.shields.io/badge/lifecycle-experimental-orange.svg)](https://lifecycle.r-lib.org/articles/stages.html#experimental) 10 | [![R-CMD-check](https://github.com/r-hub/rhub2/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/r-hub/rhub2/actions/workflows/R-CMD-check.yaml) 11 | [![](https://www.r-pkg.org/badges/version/rhub2)](https://www.r-pkg.org/pkg/rhub2) 12 | [![Codecov test coverage](https://codecov.io/gh/r-hub/rhub2/branch/main/graph/badge.svg)](https://app.codecov.io/gh/r-hub/rhub2?branch=main) 13 | 14 | 15 | R-hub 2 uses GitHub Actions to run `R CMD check` and similar package checks. 16 | The rhub2 package helps you set up R-hub 2 for your R package, and start 17 | running checks. 18 | 19 | --- 20 | -------------------------------------------------------------------------------- /inst/workflow/rhub.yaml: -------------------------------------------------------------------------------- 1 | # R-hub's generic GitHub Actions workflow file. It's canonical location is at 2 | # https://github.com/r-hub/rhub2/blob/v1/inst/workflow/rhub.yaml 3 | # You can update this file to a newer version using the rhub2 package: 4 | # 5 | # rhub2::rhub_setup() 6 | # 7 | # It is unlikely that you need to modify this file manually. 8 | 9 | name: R-hub 10 | run-name: "${{ github.event.inputs.id }}: ${{ github.event.inputs.name || format('Manually run by {0}', github.triggering_actor) }}" 11 | 12 | on: 13 | workflow_dispatch: 14 | inputs: 15 | config: 16 | description: 'A comma separated list of R-hub platforms to use.' 17 | type: string 18 | default: 'linux,windows,macos' 19 | name: 20 | description: 'Run name. You can leave this empty now.' 21 | type: string 22 | id: 23 | description: 'Unique ID. You can leave this empty now.' 24 | type: string 25 | 26 | jobs: 27 | 28 | setup: 29 | runs-on: ubuntu-latest 30 | outputs: 31 | containers: ${{ steps.rhub-setup.outputs.containers }} 32 | platforms: ${{ steps.rhub-setup.outputs.platforms }} 33 | 34 | steps: 35 | # NO NEED TO CHECKOUT HERE 36 | - uses: r-hub/rhub2/actions/rhub-setup@v1 37 | with: 38 | config: ${{ github.event.inputs.config }} 39 | id: rhub-setup 40 | 41 | linux-containers: 42 | needs: setup 43 | if: ${{ needs.setup.outputs.containers != '[]' }} 44 | runs-on: ubuntu-latest 45 | name: ${{ matrix.config.label }} 46 | strategy: 47 | fail-fast: false 48 | matrix: 49 | config: ${{ fromJson(needs.setup.outputs.containers) }} 50 | container: 51 | image: ${{ matrix.config.container }} 52 | 53 | steps: 54 | - uses: r-hub/rhub2/actions/rhub-checkout@v1 55 | - uses: r-hub/rhub2/actions/rhub-platform-info@v1 56 | with: 57 | token: ${{ secrets.RHUB_TOKEN }} 58 | job-config: ${{ matrix.config.job-config }} 59 | - uses: r-hub/rhub2/actions/rhub-setup-deps@v1 60 | with: 61 | token: ${{ secrets.RHUB_TOKEN }} 62 | job-config: ${{ matrix.config.job-config }} 63 | - uses: r-hub/rhub2/actions/rhub-run-check@v1 64 | with: 65 | token: ${{ secrets.RHUB_TOKEN }} 66 | job-config: ${{ matrix.config.job-config }} 67 | 68 | other-platforms: 69 | needs: setup 70 | if: ${{ needs.setup.outputs.platforms != '[]' }} 71 | runs-on: ${{ matrix.config.os }} 72 | name: ${{ matrix.config.label }} 73 | strategy: 74 | fail-fast: false 75 | matrix: 76 | config: ${{ fromJson(needs.setup.outputs.platforms) }} 77 | 78 | steps: 79 | - uses: r-hub/rhub2/actions/rhub-checkout@v1 80 | - uses: r-hub/rhub2/actions/rhub-setup-r@v1 81 | with: 82 | job-config: ${{ matrix.config.job-config }} 83 | token: ${{ secrets.RHUB_TOKEN }} 84 | - uses: r-hub/rhub2/actions/rhub-platform-info@v1 85 | with: 86 | token: ${{ secrets.RHUB_TOKEN }} 87 | job-config: ${{ matrix.config.job-config }} 88 | - uses: r-hub/rhub2/actions/rhub-setup-deps@v1 89 | with: 90 | job-config: ${{ matrix.config.job-config }} 91 | token: ${{ secrets.RHUB_TOKEN }} 92 | - uses: r-hub/rhub2/actions/rhub-run-check@v1 93 | with: 94 | job-config: ${{ matrix.config.job-config }} 95 | token: ${{ secrets.RHUB_TOKEN }} 96 | -------------------------------------------------------------------------------- /man/figures/rhub-check-dark.svg: -------------------------------------------------------------------------------- 1 | ✔Foundgitrepositoryat/private/tmp/cli.✔FoundGitHubPAT.Availableplatforms(see`rhub2::rhub_platforms()`fordetails):1[VM]linuxR-*(anyversion)ubuntu-latestonG…2[VM]macosR-*(anyversion)macos-latestonGi…3[VM]windowsR-*(anyversion)windows-lateston…4[CT]atlasR-devel(2023-05-27r84465)FedoraLinux36(C…5[CT]clang-asanR-devel(2023-05-27r84465)Ubuntu22.04.2LTS6[CT]clang16R-devel(2023-05-27r84465)Ubuntu22.04.2LTS7[CT]gcc13R-devel(2023-05-27r84465)FedoraLinux38(C…8[CT]noldR-devel(2023-05-27r84465)Ubuntu22.04.2LTS9[CT]ubuntu-clangR-devel(2023-05-27r84465)Ubuntu22.04.2LTS10[CT]ubuntu-gcc12R-devel(2023-05-27r84465)Ubuntu22.04.2LTS11[CT]ubuntu-nextR-4.3.0(patched)(2023-05-23r84465)Ubuntu22.04.2LTS12[CT]ubuntu-releaseR-4.3.0(2023-04-21)Ubuntu22.04.2LTSSelection(commaseparatednumbers,0tocancel):1,5✔Checkstarted:linux,clang-asan(artless-songbird).See<https://github.com/r-lib/cli/actions>forliveoutput! -------------------------------------------------------------------------------- /man/figures/rhub-check.svg: -------------------------------------------------------------------------------- 1 | ✔Foundgitrepositoryat/private/tmp/cli.✔FoundGitHubPAT.Availableplatforms(see`rhub2::rhub_platforms()`fordetails):1[VM]linuxR-*(anyversion)ubuntu-latestonG…2[VM]macosR-*(anyversion)macos-latestonGi…3[VM]windowsR-*(anyversion)windows-lateston…4[CT]atlasR-devel(2023-05-27r84465)FedoraLinux36(C…5[CT]clang-asanR-devel(2023-05-27r84465)Ubuntu22.04.2LTS6[CT]clang16R-devel(2023-05-27r84465)Ubuntu22.04.2LTS7[CT]gcc13R-devel(2023-05-27r84465)FedoraLinux38(C…8[CT]noldR-devel(2023-05-27r84465)Ubuntu22.04.2LTS9[CT]ubuntu-clangR-devel(2023-05-27r84465)Ubuntu22.04.2LTS10[CT]ubuntu-gcc12R-devel(2023-05-27r84465)Ubuntu22.04.2LTS11[CT]ubuntu-nextR-4.3.0(patched)(2023-05-23r84465)Ubuntu22.04.2LTS12[CT]ubuntu-releaseR-4.3.0(2023-04-21)Ubuntu22.04.2LTSSelection(commaseparatednumbers,0tocancel):1,5✔Checkstarted:linux,clang-asan(artless-songbird).See<https://github.com/r-lib/cli/actions>forliveoutput! -------------------------------------------------------------------------------- /man/figures/rhub-doctor-dark.svg: -------------------------------------------------------------------------------- 1 | ✔FoundRpackageat/private/tmp/cli.✔Foundgitrepositoryat/private/tmp/cli.✔FoundGitHubPAT.✔FoundrepositoryonGitHubat<https://github.com/r-lib/cli>.✔GitHubPAThastherightscopes.✔FoundR-hubworkflowindefaultbranch,anditisactive.→WOOT!Youarereadytorun`rhub2::rhub_check()`onthispackage. -------------------------------------------------------------------------------- /man/figures/rhub-doctor.svg: -------------------------------------------------------------------------------- 1 | ✔FoundRpackageat/private/tmp/cli.✔Foundgitrepositoryat/private/tmp/cli.✔FoundGitHubPAT.✔FoundrepositoryonGitHubat<https://github.com/r-lib/cli>.✔GitHubPAThastherightscopes.✔FoundR-hubworkflowindefaultbranch,anditisactive.→WOOT!Youarereadytorun`rhub2::rhub_check()`onthispackage. -------------------------------------------------------------------------------- /man/figures/rhub-platforms-dark.svg: -------------------------------------------------------------------------------- 1 | RUnderdevelopment(unstable)(2023-05-27r84465)onUbuntu22.04.2LTS──Virtualmachines───────────────────────────────────────────────────────────1[VM]linuxAllRversionsonGitHubActionsubuntu-latest2[VM]macosAllRversionsonGitHubActionsmacos-latest3[VM]windowsAllRversionsonGitHubActionswindows-latest──Containers─────────────────────────────────────────────────────────────────4[CT]atlas[ATLAS]RUnderdevelopment(unstable)(2023-05-27r84465)onFedoraLinux36(Conta…ghcr.io/r-hub/containers/atlas:latest5[CT]clang-asan[asan,clang-ASAN,clang-UBSAN,ubsan]ghcr.io/r-hub/containers/clang-asan:latest6[CT]clang16[clang16]ghcr.io/r-hub/containers/clang16:latest7[CT]gcc13[gcc13]RUnderdevelopment(unstable)(2023-05-27r84465)onFedoraLinux38(Conta…ghcr.io/r-hub/containers/gcc13:latest8[CT]nold[noLD]ghcr.io/r-hub/containers/nold:latest9[CT]ubuntu-clang[r-devel-linux-x86_64-debian-clang]ghcr.io/r-hub/containers/ubuntu-clang:latest10[CT]ubuntu-gcc12[r-devel-linux-x86_64-debian-gcc]ghcr.io/r-hub/containers/ubuntu-gcc12:latest11[CT]ubuntu-next[r-next,r-patched,r-patched-linux-x86_64]Rversion4.3.0Patched(2023-05-23r84465)onUbuntu22.04.2LTSghcr.io/r-hub/containers/ubuntu-next:latest12[CT]ubuntu-release[r-release,r-release-linux-x86_64,ubuntu]Rversion4.3.0(2023-04-21)onUbuntu22.04.2LTSghcr.io/r-hub/containers/ubuntu-release:latest -------------------------------------------------------------------------------- /man/figures/rhub-platforms.svg: -------------------------------------------------------------------------------- 1 | RUnderdevelopment(unstable)(2023-05-27r84465)onUbuntu22.04.2LTS──Virtualmachines───────────────────────────────────────────────────────────1[VM]linuxAllRversionsonGitHubActionsubuntu-latest2[VM]macosAllRversionsonGitHubActionsmacos-latest3[VM]windowsAllRversionsonGitHubActionswindows-latest──Containers─────────────────────────────────────────────────────────────────4[CT]atlas[ATLAS]RUnderdevelopment(unstable)(2023-05-27r84465)onFedoraLinux36(Conta…ghcr.io/r-hub/containers/atlas:latest5[CT]clang-asan[asan,clang-ASAN,clang-UBSAN,ubsan]ghcr.io/r-hub/containers/clang-asan:latest6[CT]clang16[clang16]ghcr.io/r-hub/containers/clang16:latest7[CT]gcc13[gcc13]RUnderdevelopment(unstable)(2023-05-27r84465)onFedoraLinux38(Conta…ghcr.io/r-hub/containers/gcc13:latest8[CT]nold[noLD]ghcr.io/r-hub/containers/nold:latest9[CT]ubuntu-clang[r-devel-linux-x86_64-debian-clang]ghcr.io/r-hub/containers/ubuntu-clang:latest10[CT]ubuntu-gcc12[r-devel-linux-x86_64-debian-gcc]ghcr.io/r-hub/containers/ubuntu-gcc12:latest11[CT]ubuntu-next[r-next,r-patched,r-patched-linux-x86_64]Rversion4.3.0Patched(2023-05-23r84465)onUbuntu22.04.2LTSghcr.io/r-hub/containers/ubuntu-next:latest12[CT]ubuntu-release[r-release,r-release-linux-x86_64,ubuntu]Rversion4.3.0(2023-04-21)onUbuntu22.04.2LTSghcr.io/r-hub/containers/ubuntu-release:latest -------------------------------------------------------------------------------- /man/figures/rhub-setup-dark.svg: -------------------------------------------------------------------------------- 1 | SettingupR-hubv2.✔FoundRpackageat/private/tmp/cli.✔Foundgitrepositoryat/private/tmp/cli.✔Createdworkflowfile/private/tmp/cli/.github/workflows/rhub.yaml.Notes:•TheworkflowfilemustbeaddedtothedefaultbranchoftheGitHubrepository.•GitHubactionsmustbeenabledfortherepository.Theyaredisabledforforkedrepositoriesbydefault.Nextsteps:•Addtheworkflowfiletogitusing`gitadd<filename>`.•Commitittogitusing`gitcommit`.•PushthecommittoGitHubusing`gitpush`.•Call`rhub2::rhub_doctor()`tocheckthatyouhavesetupR-hubcorrectly.•Call`rhub2::rhub_check()`tocheckyourpackage. -------------------------------------------------------------------------------- /man/figures/rhub-setup.svg: -------------------------------------------------------------------------------- 1 | SettingupR-hubv2.✔FoundRpackageat/private/tmp/cli.✔Foundgitrepositoryat/private/tmp/cli.✔Createdworkflowfile/private/tmp/cli/.github/workflows/rhub.yaml.Notes:•TheworkflowfilemustbeaddedtothedefaultbranchoftheGitHubrepository.•GitHubactionsmustbeenabledfortherepository.Theyaredisabledforforkedrepositoriesbydefault.Nextsteps:•Addtheworkflowfiletogitusing`gitadd<filename>`.•Commitittogitusing`gitcommit`.•PushthecommittoGitHubusing`gitpush`.•Call`rhub2::rhub_doctor()`tocheckthatyouhavesetupR-hubcorrectly.•Call`rhub2::rhub_check()`tocheckyourpackage. -------------------------------------------------------------------------------- /man/rhub_check.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/check.R 3 | \name{rhub_check} 4 | \alias{rhub_check} 5 | \title{Check a package on R-hub} 6 | \usage{ 7 | rhub_check(gh_url = NULL, platforms = NULL, r_versions = NULL, branch = NULL) 8 | } 9 | \arguments{ 10 | \item{gh_url}{GitHub URL of a package to check, or \code{NULL} to check 11 | the package in the current directory.} 12 | 13 | \item{platforms}{Platforms to use, a character vector. Use \code{NULL} to 14 | select from a list in interactive sessions. See \code{\link[=rhub_platforms]{rhub_platforms()}}.} 15 | 16 | \item{r_versions}{Which R version(s) to use for the platforms that 17 | supports multiple R versions. This arguemnt is not implemented yet.} 18 | 19 | \item{branch}{Branch to use to run R-hub. Defaults to the current 20 | branch if \code{gh_url} is \code{NULL}. Otherwise defaults to \code{"main"}. Note that 21 | this branch also need to include the \code{rhub.yaml} workflow file.} 22 | } 23 | \value{ 24 | TODO 25 | } 26 | \description{ 27 | Check a package on R-hub 28 | } 29 | -------------------------------------------------------------------------------- /man/rhub_doctor.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/doctor.R 3 | \name{rhub_doctor} 4 | \alias{rhub_doctor} 5 | \title{Check if the current or the specified package is ready to use with R-hub} 6 | \usage{ 7 | rhub_doctor(gh_url = NULL) 8 | } 9 | \arguments{ 10 | \item{gh_url}{Use \code{NULL} for the package in the current working 11 | directory. Alternatively, use the URL of a GitHub repository that 12 | contains an R package that was set up to use with R-hub.} 13 | } 14 | \description{ 15 | Errors if the package or repository is not set up correctly, and 16 | advises on possible solutions. 17 | } 18 | -------------------------------------------------------------------------------- /man/rhub_platforms.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/platforms.R 3 | \name{rhub_platforms} 4 | \alias{rhub_platforms} 5 | \title{List R-hub platforms} 6 | \usage{ 7 | rhub_platforms() 8 | } 9 | \value{ 10 | Data frame with columns: 11 | \itemize{ 12 | \item \code{name}: platform name. Use this in the \code{platforms} argument of 13 | \code{\link[=rhub_check]{rhub_check()}}. 14 | \item \code{aliases}: alternative platform names. They can also be used in the 15 | \code{platforms} argument of \code{\link[=rhub_check]{rhub_check()}}. 16 | \item \code{type}: \code{"os"} or \code{"container"}. 17 | \item \code{os_type}: Linux, macOS or Windows currently. 18 | \item \code{container}: URL of the container image for container platforms. 19 | \item \code{github_os}: name of the OS on GitHub Actions for non-container 20 | platforms. 21 | \item \code{r_version}: R version string. If \code{"*"} then any supported R version 22 | can be selected for this platform. 23 | \item \code{os_name}: name of the operating system, including Linux distribution 24 | name and version for container actions. 25 | } 26 | } 27 | \description{ 28 | List R-hub platforms 29 | } 30 | -------------------------------------------------------------------------------- /man/rhub_setup.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/setup.R 3 | \name{rhub_setup} 4 | \alias{rhub_setup} 5 | \title{Setup the current R package for use with R-hub} 6 | \usage{ 7 | rhub_setup(overwrite = FALSE) 8 | } 9 | \arguments{ 10 | \item{overwrite}{if \code{TRUE}, \code{\link[=rhub_setup]{rhub_setup()}} will overwrite an already 11 | existing workflow file.} 12 | } 13 | \value{ 14 | Nothing. 15 | } 16 | \description{ 17 | It adds or updates the R-hub workflow file to the current package, 18 | and advises on next steps. 19 | } 20 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | # This file is part of the standard setup for testthat. 2 | # It is recommended that you do not modify it. 3 | # 4 | # Where should you do additional test configuration? 5 | # Learn more about the roles of various files in: 6 | # * https://r-pkgs.org/tests.html 7 | # * https://testthat.r-lib.org/reference/test_package.html#special-files 8 | 9 | library(testthat) 10 | library(rhub2) 11 | 12 | test_check("rhub2") 13 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/gh.md: -------------------------------------------------------------------------------- 1 | # parse_gh_url 2 | 3 | Code 4 | parse_gh_url("https://github.com/foo/bar.git") 5 | Output 6 | $host 7 | [1] "github.com" 8 | 9 | $api 10 | [1] "https://api.github.com" 11 | 12 | $graphql 13 | [1] "https://api.github.com/graphql" 14 | 15 | $user 16 | [1] "foo" 17 | 18 | $repo 19 | [1] "bar" 20 | 21 | $slug 22 | [1] "foo/bar" 23 | 24 | Code 25 | parse_gh_url("https://myserver.org/foo/bar.git") 26 | Output 27 | $host 28 | [1] "myserver.org" 29 | 30 | $api 31 | [1] "https://myserver.org/api/v3" 32 | 33 | $graphql 34 | [1] "https://myserver.org/api/graphql" 35 | 36 | $user 37 | [1] "foo" 38 | 39 | $repo 40 | [1] "bar" 41 | 42 | $slug 43 | [1] "foo/bar" 44 | 45 | 46 | -------------------------------------------------------------------------------- /tests/testthat/test-gh.R: -------------------------------------------------------------------------------- 1 | 2 | test_that("parse_gh_url", { 3 | expect_snapshot({ 4 | parse_gh_url("https://github.com/foo/bar.git") 5 | parse_gh_url("https://myserver.org/foo/bar.git") 6 | }) 7 | }) 8 | --------------------------------------------------------------------------------