├── air.toml ├── .github ├── .gitignore └── workflows │ ├── pkgdown.yaml │ ├── format-suggest.yaml │ ├── test-coverage.yaml │ ├── R-CMD-check.yaml │ └── pr-commands.yaml ├── vignettes ├── .gitignore └── cloud.Rmd ├── LICENSE ├── .gitignore ├── tests ├── testthat.R └── testthat │ ├── test.R │ ├── test-db.R │ └── test-deps.R ├── .vscode ├── extensions.json └── settings.json ├── R ├── onload.R ├── assertions.R ├── json.R ├── cleanup.R ├── pkg.R ├── library.R ├── report-checklist.R ├── download.R ├── compare.R ├── results.R ├── todo.R ├── utils.R ├── deps.R ├── dirs.R ├── compat-purrr.R ├── deps-install.R ├── check.R ├── email.R ├── revdepcheck.R ├── event-loop.R ├── db.R ├── report.R └── cloud.R ├── codecov.yml ├── .Rbuildignore ├── _pkgdown.yml ├── man ├── revdep_maintainers.Rd ├── db_setup.Rd ├── cloud_job_mapping.Rd ├── revdep_env_vars.Rd ├── revdep_details.Rd ├── cloud_job.Rd ├── cran_revdeps.Rd ├── cloud_cancel.Rd ├── cloud_plot.Rd ├── cloud_summary.Rd ├── schedule_next_task.Rd ├── cloud_details.Rd ├── cloud_results.Rd ├── cloud_status.Rd ├── cloud_browse.Rd ├── cloud_fetch_results.Rd ├── revdep_add.Rd ├── cloud_broken.Rd ├── cloud_email.Rd ├── revdep_email.Rd ├── run_event_loop.Rd ├── cloud_check.Rd ├── revdep_report_summary.Rd ├── dir_find.Rd ├── cloud_report.Rd └── revdep_check.Rd ├── revdepcheck.Rproj ├── LICENSE.md ├── inst └── templates │ ├── email-failed.txt │ └── email-broken.txt ├── NEWS.md ├── DESCRIPTION ├── README.md └── NAMESPACE /air.toml: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /.github/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | -------------------------------------------------------------------------------- /vignettes/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | *.R 3 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2020 2 | COPYRIGHT HOLDER: revdepcheck authors 3 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | .httr-oauth 5 | inst/doc 6 | docs 7 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(revdepcheck) 3 | 4 | test_check("revdepcheck") 5 | -------------------------------------------------------------------------------- /.vscode/extensions.json: -------------------------------------------------------------------------------- 1 | { 2 | "recommendations": [ 3 | "Posit.air-vscode" 4 | ] 5 | } 6 | -------------------------------------------------------------------------------- /tests/testthat/test.R: -------------------------------------------------------------------------------- 1 | context("revdepcheck") 2 | 3 | test_that("revdepcheck works", { 4 | expect_true(TRUE) 5 | }) 6 | -------------------------------------------------------------------------------- /R/onload.R: -------------------------------------------------------------------------------- 1 | .onLoad <- function(libname, pkgname) { 2 | if (requireNamespace("debugme", quietly = TRUE)) { 3 | debugme::debugme() 4 | } 5 | } 6 | -------------------------------------------------------------------------------- /.vscode/settings.json: -------------------------------------------------------------------------------- 1 | { 2 | "[r]": { 3 | "editor.formatOnSave": true, 4 | "editor.defaultFormatter": "Posit.air-vscode" 5 | }, 6 | "[quarto]": { 7 | "editor.formatOnSave": true, 8 | "editor.defaultFormatter": "quarto.quarto" 9 | } 10 | } 11 | -------------------------------------------------------------------------------- /R/assertions.R: -------------------------------------------------------------------------------- 1 | #' @importFrom assertthat assert_that on_failure<- 2 | 3 | is_string <- function(x) { 4 | is.character(x) && length(x) == 1 && !is.na(x) 5 | } 6 | 7 | on_failure(is_string) <- function(call, env) { 8 | paste0(deparse(call$x), " is not a string (length 1 character)") 9 | } 10 | -------------------------------------------------------------------------------- /codecov.yml: -------------------------------------------------------------------------------- 1 | comment: false 2 | 3 | coverage: 4 | status: 5 | project: 6 | default: 7 | target: auto 8 | threshold: 1% 9 | informational: true 10 | patch: 11 | default: 12 | target: auto 13 | threshold: 1% 14 | informational: true 15 | -------------------------------------------------------------------------------- /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^Makefile$ 4 | ^README.Rmd$ 5 | ^.travis.yml$ 6 | ^appveyor.yml$ 7 | ^revdep$ 8 | ^\.travis\.yml$ 9 | ^\.httr-oauth$ 10 | ^codecov\.yml$ 11 | ^\.github$ 12 | ^_pkgdown\.yml$ 13 | ^docs$ 14 | ^pkgdown$ 15 | ^LICENSE\.md$ 16 | ^[.]?air[.]toml$ 17 | ^\.vscode$ 18 | -------------------------------------------------------------------------------- /_pkgdown.yml: -------------------------------------------------------------------------------- 1 | url: https://revdepcheck.r-lib.org 2 | 3 | # don't use dev mode: auto since revdepcheck is not released on CRAN 4 | development: 5 | mode: release 6 | 7 | template: 8 | package: tidytemplate 9 | bootstrap: 5 10 | 11 | includes: 12 | in_header: | 13 | 14 | -------------------------------------------------------------------------------- /man/revdep_maintainers.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/email.R 3 | \name{revdep_maintainers} 4 | \alias{revdep_maintainers} 5 | \title{List maintainers of all reverse dependencies} 6 | \usage{ 7 | revdep_maintainers(pkg = ".") 8 | } 9 | \arguments{ 10 | \item{pkg}{Path to package.} 11 | } 12 | \description{ 13 | List maintainers of all reverse dependencies 14 | } 15 | -------------------------------------------------------------------------------- /man/db_setup.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/db.R 3 | \name{db_setup} 4 | \alias{db_setup} 5 | \title{Make sure that the database exists} 6 | \usage{ 7 | db_setup(package) 8 | } 9 | \arguments{ 10 | \item{package}{The name of the package under revdep cheking.} 11 | } 12 | \value{ 13 | Nothing 14 | } 15 | \description{ 16 | Make sure that the database exists 17 | } 18 | \keyword{internal} 19 | -------------------------------------------------------------------------------- /revdepcheck.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: knitr 13 | LaTeX: XeLaTeX 14 | 15 | AutoAppendNewline: Yes 16 | StripTrailingWhitespace: Yes 17 | 18 | BuildType: Package 19 | PackageUseDevtools: Yes 20 | PackageInstallArgs: --no-multiarch --with-keep.source 21 | PackageRoxygenize: rd,collate,namespace 22 | -------------------------------------------------------------------------------- /man/cloud_job_mapping.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cloud.R 3 | \name{cloud_job_mapping} 4 | \alias{cloud_job_mapping} 5 | \title{Get a tibble of batch sub-job ids for all checked packages} 6 | \usage{ 7 | cloud_job_mapping(job_name = cloud_job()) 8 | } 9 | \arguments{ 10 | \item{job_name}{The job name, as returned by \code{\link[=cloud_check]{cloud_check()}}.} 11 | } 12 | \description{ 13 | Get a tibble of batch sub-job ids for all checked packages 14 | } 15 | -------------------------------------------------------------------------------- /tests/testthat/test-db.R: -------------------------------------------------------------------------------- 1 | context("db") 2 | 3 | 4 | # metadata ---------------------------------------------------------------- 5 | 6 | test_that("can get and set metadata", { 7 | db_setup(":memory:") 8 | 9 | db_metadata_set(":memory:", "x", "abc") 10 | expect_equal(db_metadata_get(":memory:", "x"), "abc") 11 | }) 12 | 13 | test_that("setting metadata replaces previous value", { 14 | db_metadata_set(":memory:", "y", "abc") 15 | db_metadata_set(":memory:", "y", "xyz") 16 | 17 | expect_equal(db_metadata_get(":memory:", "y"), "xyz") 18 | }) 19 | -------------------------------------------------------------------------------- /man/revdep_env_vars.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/check.R 3 | \name{revdep_env_vars} 4 | \alias{revdep_env_vars} 5 | \title{Environment variables to set for install and check processes while 6 | running the reverse dependency check} 7 | \usage{ 8 | revdep_env_vars(force_suggests = FALSE) 9 | } 10 | \arguments{ 11 | \item{force_suggests}{Whether to force the installation of the 12 | suggested packages.} 13 | } 14 | \value{ 15 | Named character vector. 16 | } 17 | \description{ 18 | Environment variables to set for install and check processes while 19 | running the reverse dependency check 20 | } 21 | -------------------------------------------------------------------------------- /man/revdep_details.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/results.R 3 | \name{revdep_details} 4 | \alias{revdep_details} 5 | \alias{revdep_summary} 6 | \title{Display revdep results} 7 | \usage{ 8 | revdep_details(pkg = ".", revdep) 9 | 10 | revdep_summary(pkg = ".") 11 | } 12 | \arguments{ 13 | \item{pkg}{Path to package} 14 | 15 | \item{revdep}{Name of revdep package.} 16 | } 17 | \description{ 18 | Use this to see nicely formatted results of processed packages while 19 | \code{\link[=revdep_check]{revdep_check()}} is running in another process. \code{revdep_summary()} 20 | displays summary results for all complete checks. \code{revdep_details()} 21 | shows you the details for one 22 | } 23 | -------------------------------------------------------------------------------- /man/cloud_job.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cloud.R 3 | \name{cloud_job} 4 | \alias{cloud_job} 5 | \title{Return the current cloud job} 6 | \usage{ 7 | cloud_job(job_name = NULL, pkg = ".") 8 | } 9 | \arguments{ 10 | \item{job_name}{If not \code{NULL}, sets the active \code{job_name} to the input.} 11 | 12 | \item{pkg}{Path to package.} 13 | } 14 | \description{ 15 | The \code{job_name} is automatically set by \code{\link[=cloud_check]{cloud_check()}} and is remembered for 16 | the duration of the current R session. If there is no active \code{job_name}, but 17 | there are local cloud check results, \code{job_name} is inferred from the most 18 | recently modified cloud check results. 19 | } 20 | -------------------------------------------------------------------------------- /tests/testthat/test-deps.R: -------------------------------------------------------------------------------- 1 | context("dependencies") 2 | 3 | test_that("parse_deps", { 4 | deps <- c( 5 | "foobar", 6 | "foobar (>= 1.0.0)", 7 | "foo, bar", 8 | "foo,bar", 9 | "foo(>= 1.0.0), bar", 10 | "foo,\n bar", 11 | "" 12 | ) 13 | expect_equal( 14 | parse_deps(deps), 15 | list( 16 | "foobar", 17 | "foobar", 18 | c("foo", "bar"), 19 | c("foo", "bar"), 20 | c("foo", "bar"), 21 | c("foo", "bar"), 22 | character() 23 | ) 24 | ) 25 | }) 26 | 27 | test_that("parse_deps extreme cases", { 28 | deps <- c(NA, "", " ") 29 | expect_equal( 30 | parse_deps(deps), 31 | list(character(), character(), character()) 32 | ) 33 | 34 | expect_equal(parse_deps(character()), list()) 35 | }) 36 | -------------------------------------------------------------------------------- /R/json.R: -------------------------------------------------------------------------------- 1 | toJSON <- function(x, force = TRUE, ...) { 2 | jsonlite::toJSON( 3 | list( 4 | class = class(x), 5 | object = unclass(x) 6 | ), 7 | force = force, 8 | ... 9 | ) 10 | } 11 | 12 | fromJSON <- function(txt, ...) { 13 | obj <- jsonlite::fromJSON(txt, ...) 14 | if (is.list(obj) && identical(names(obj), c("class", "object"))) { 15 | structure(obj$object, class = obj$class) 16 | } else { 17 | obj 18 | } 19 | } 20 | 21 | checkFromJSON <- function(txt, ...) { 22 | if (identical(txt, NA_character_)) { 23 | return() 24 | } 25 | 26 | check <- fromJSON(txt, ...) 27 | check$errors <- as.character(check$errors) 28 | check$warnings <- as.character(check$warnings) 29 | check$notes <- as.character(check$notes) 30 | check 31 | } 32 | -------------------------------------------------------------------------------- /man/cran_revdeps.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/deps.R 3 | \name{cran_revdeps} 4 | \alias{cran_revdeps} 5 | \title{Retrieve the reverse dependencies for a package} 6 | \usage{ 7 | cran_revdeps(package, dependencies = TRUE, bioc = FALSE, cran = TRUE) 8 | } 9 | \arguments{ 10 | \item{package}{The package (or packages) to search for reverse dependencies.} 11 | 12 | \item{dependencies}{Which types of revdeps should be checked. For CRAN 13 | release, we recommend using the default.} 14 | 15 | \item{bioc}{Also check revdeps that live in Bioconductor?} 16 | 17 | \item{cran}{Should cran mirror be attached to getOpion("repos") if it 18 | is not already present.} 19 | } 20 | \description{ 21 | Retrieve the reverse dependencies for a package 22 | } 23 | -------------------------------------------------------------------------------- /R/cleanup.R: -------------------------------------------------------------------------------- 1 | cleanup_library <- function(state, worker) { 2 | pkgdir <- state$options$pkgdir 3 | package <- worker$package 4 | if (is.null(pkgdir) || is.null(package)) { 5 | return() 6 | } 7 | 8 | libdir <- dir_find(pkgdir, "pkg", package) 9 | unlink(libdir, recursive = TRUE) 10 | } 11 | 12 | cleanup_chkres <- function(state, worker, iam_old) { 13 | pkgdir <- state$options$pkgdir 14 | package <- worker$package 15 | 16 | # Delete all sources/binaries cached by R CMD check 17 | check_dir <- dir_find(pkgdir, "check", package) 18 | rcheck <- file.path( 19 | check_dir, 20 | if (iam_old) "old" else "new", 21 | paste0(package, ".Rcheck") 22 | ) 23 | 24 | unlink(file.path(rcheck, "00_pkg_src"), recursive = TRUE) 25 | unlink(file.path(rcheck, package), recursive = TRUE) 26 | } 27 | -------------------------------------------------------------------------------- /man/cloud_cancel.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cloud.R 3 | \name{cloud_cancel} 4 | \alias{cloud_cancel} 5 | \title{Cancel a running cloud run} 6 | \usage{ 7 | cloud_cancel(job_name = cloud_job()) 8 | } 9 | \arguments{ 10 | \item{job_name}{The job name, as returned by \code{\link[=cloud_check]{cloud_check()}}.} 11 | } 12 | \description{ 13 | Cancel a running cloud run 14 | } 15 | \seealso{ 16 | Other cloud: 17 | \code{\link{cloud_broken}()}, 18 | \code{\link{cloud_browse}()}, 19 | \code{\link{cloud_check}()}, 20 | \code{\link{cloud_details}()}, 21 | \code{\link{cloud_fetch_results}()}, 22 | \code{\link{cloud_plot}()}, 23 | \code{\link{cloud_report}()}, 24 | \code{\link{cloud_results}()}, 25 | \code{\link{cloud_status}()}, 26 | \code{\link{cloud_summary}()} 27 | } 28 | \concept{cloud} 29 | -------------------------------------------------------------------------------- /R/pkg.R: -------------------------------------------------------------------------------- 1 | pkg_check <- function(pkgdir) { 2 | if (!is_string(pkgdir)) { 3 | stop("`pkgdir` must be a string", call. = FALSE) 4 | } 5 | 6 | if (!file.exists(pkgdir) || !file.info(pkgdir)$isdir) { 7 | stop("`pkgdir` must be an existing directory", call. = FALSE) 8 | } 9 | 10 | if (!file.exists(file.path(pkgdir, "DESCRIPTION"))) { 11 | stop("`pkgdir` must contain a DESCRIPTION file", call. = FALSE) 12 | } 13 | 14 | normalizePath(pkgdir, mustWork = FALSE) 15 | } 16 | 17 | pkg_name <- function(pkgdir) { 18 | read.dcf(file.path(pkgdir, "DESCRIPTION"))[, "Package"][[1]] 19 | } 20 | 21 | pkg_version <- function(pkgdir) { 22 | read.dcf(file.path(pkgdir, "DESCRIPTION"))[, "Version"][[1]] 23 | } 24 | 25 | pkg_bug_reports <- function(pkgdir) { 26 | read.dcf(file.path(pkgdir, "DESCRIPTION"))[, "BugReports"][[1]] 27 | } 28 | -------------------------------------------------------------------------------- /man/cloud_plot.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cloud.R 3 | \name{cloud_plot} 4 | \alias{cloud_plot} 5 | \title{Plot the running time per package of a cloud job} 6 | \usage{ 7 | cloud_plot(job_name = cloud_job()) 8 | } 9 | \arguments{ 10 | \item{job_name}{The job name, as returned by \code{\link[=cloud_check]{cloud_check()}}.} 11 | } 12 | \description{ 13 | Plot the running time per package of a cloud job 14 | } 15 | \seealso{ 16 | Other cloud: 17 | \code{\link{cloud_broken}()}, 18 | \code{\link{cloud_browse}()}, 19 | \code{\link{cloud_cancel}()}, 20 | \code{\link{cloud_check}()}, 21 | \code{\link{cloud_details}()}, 22 | \code{\link{cloud_fetch_results}()}, 23 | \code{\link{cloud_report}()}, 24 | \code{\link{cloud_results}()}, 25 | \code{\link{cloud_status}()}, 26 | \code{\link{cloud_summary}()} 27 | } 28 | \concept{cloud} 29 | -------------------------------------------------------------------------------- /man/cloud_summary.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cloud.R 3 | \name{cloud_summary} 4 | \alias{cloud_summary} 5 | \title{Display revdep results} 6 | \usage{ 7 | cloud_summary(job_name = cloud_job(pkg = pkg), pkg = ".") 8 | } 9 | \arguments{ 10 | \item{job_name}{The job name, as returned by \code{\link[=cloud_check]{cloud_check()}}.} 11 | 12 | \item{pkg}{Path to package.} 13 | } 14 | \description{ 15 | Displays nicely formatted results of processed packages run in the cloud. 16 | } 17 | \seealso{ 18 | Other cloud: 19 | \code{\link{cloud_broken}()}, 20 | \code{\link{cloud_browse}()}, 21 | \code{\link{cloud_cancel}()}, 22 | \code{\link{cloud_check}()}, 23 | \code{\link{cloud_details}()}, 24 | \code{\link{cloud_fetch_results}()}, 25 | \code{\link{cloud_plot}()}, 26 | \code{\link{cloud_report}()}, 27 | \code{\link{cloud_results}()}, 28 | \code{\link{cloud_status}()} 29 | } 30 | \concept{cloud} 31 | -------------------------------------------------------------------------------- /man/schedule_next_task.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/event-loop.R 3 | \name{schedule_next_task} 4 | \alias{schedule_next_task} 5 | \title{Decide what to do next, from the current state} 6 | \usage{ 7 | schedule_next_task(state) 8 | } 9 | \arguments{ 10 | \item{state}{See \code{\link[=run_event_loop]{run_event_loop()}} for a description.} 11 | } 12 | \description{ 13 | In we have reached the allowed number of workers, then we schedule an 14 | idle job, we just need to wait until a worker is done. 15 | } 16 | \details{ 17 | Otherwise we schedule a job. In general the strategy is to finish check 18 | as soon as possible, so if a package is in \code{deps_installed}, then we 19 | schedule a check. Otherwise, if a package is in \code{todo}, then we 20 | schedule a dependency install. 21 | 22 | If there is nothing we can do now, then we schedule an idle job, i.e. 23 | just wait until a worker gets done. 24 | } 25 | \keyword{internal} 26 | -------------------------------------------------------------------------------- /R/library.R: -------------------------------------------------------------------------------- 1 | library_compare <- function(pkg) { 2 | lib_new <- library_meta(dir_find(pkg, "new")) 3 | lib_old <- library_meta(dir_find(pkg, "old")) 4 | 5 | lib_cmp <- merge( 6 | data.frame( 7 | package = lib_old$Package, 8 | old = lib_old$Version, 9 | stringsAsFactors = FALSE 10 | ), 11 | data.frame( 12 | package = lib_new$Package, 13 | new = lib_new$Version, 14 | stringsAsFactors = FALSE 15 | ), 16 | all = TRUE 17 | ) 18 | 19 | same <- function(x, y) (is.na(x) == is.na(y)) & (x == y) 20 | lib_cmp$delta <- ifelse(same(lib_cmp$new, lib_cmp$old), "", "*") 21 | 22 | # Move tested package to top 23 | pkgname <- pkg_name(pkg) 24 | 25 | idx <- which(lib_cmp$package == pkgname) 26 | lib_cmp[union(idx, seq_len(nrow(lib_cmp))), , drop = FALSE] 27 | } 28 | 29 | library_meta <- function(libpath) { 30 | lib <- installed.packages(libpath) 31 | rownames(lib) <- NULL 32 | as.data.frame(lib, stringsAsFactors = FALSE) 33 | } 34 | -------------------------------------------------------------------------------- /man/cloud_details.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cloud.R 3 | \name{cloud_details} 4 | \alias{cloud_details} 5 | \title{Display detailed revdep results from a cloud run} 6 | \usage{ 7 | cloud_details(job_name = cloud_job(pkg = pkg), revdep, pkg = ".") 8 | } 9 | \arguments{ 10 | \item{job_name}{The job name, as returned by \code{\link[=cloud_check]{cloud_check()}}.} 11 | 12 | \item{revdep}{Name of the revdep package} 13 | 14 | \item{pkg}{Path to package.} 15 | } 16 | \description{ 17 | Display detailed revdep results from a cloud run 18 | } 19 | \seealso{ 20 | Other cloud: 21 | \code{\link{cloud_broken}()}, 22 | \code{\link{cloud_browse}()}, 23 | \code{\link{cloud_cancel}()}, 24 | \code{\link{cloud_check}()}, 25 | \code{\link{cloud_fetch_results}()}, 26 | \code{\link{cloud_plot}()}, 27 | \code{\link{cloud_report}()}, 28 | \code{\link{cloud_results}()}, 29 | \code{\link{cloud_status}()}, 30 | \code{\link{cloud_summary}()} 31 | } 32 | \concept{cloud} 33 | -------------------------------------------------------------------------------- /man/cloud_results.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cloud.R 3 | \name{cloud_results} 4 | \alias{cloud_results} 5 | \title{Retrieve cloud results} 6 | \usage{ 7 | cloud_results(job_name = cloud_job(pkg = pkg), pkg = ".") 8 | } 9 | \arguments{ 10 | \item{job_name}{The job name, as returned by \code{\link[=cloud_check]{cloud_check()}}.} 11 | 12 | \item{pkg}{Path to package.} 13 | } 14 | \description{ 15 | Intended for expert use only, this can be used as input to the \code{\link[=cloud_report]{cloud_report()}} and other functions. 16 | } 17 | \seealso{ 18 | Other cloud: 19 | \code{\link{cloud_broken}()}, 20 | \code{\link{cloud_browse}()}, 21 | \code{\link{cloud_cancel}()}, 22 | \code{\link{cloud_check}()}, 23 | \code{\link{cloud_details}()}, 24 | \code{\link{cloud_fetch_results}()}, 25 | \code{\link{cloud_plot}()}, 26 | \code{\link{cloud_report}()}, 27 | \code{\link{cloud_status}()}, 28 | \code{\link{cloud_summary}()} 29 | } 30 | \concept{cloud} 31 | \keyword{internal} 32 | -------------------------------------------------------------------------------- /man/cloud_status.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cloud.R 3 | \name{cloud_status} 4 | \alias{cloud_status} 5 | \title{Monitor the status of a cloud job} 6 | \usage{ 7 | cloud_status(job_name = cloud_job(), update_interval = 10) 8 | } 9 | \arguments{ 10 | \item{job_name}{The job name, as returned by \code{\link[=cloud_check]{cloud_check()}}.} 11 | 12 | \item{update_interval}{The number of seconds between querying for updates} 13 | } 14 | \description{ 15 | The format of the status bar is 16 | \verb{[jobs_queued/jobs_running/jobs_succeeded/jobs_failed - total_jobs] time_elapsed | ETA: estimate_time_remaining} 17 | } 18 | \seealso{ 19 | Other cloud: 20 | \code{\link{cloud_broken}()}, 21 | \code{\link{cloud_browse}()}, 22 | \code{\link{cloud_cancel}()}, 23 | \code{\link{cloud_check}()}, 24 | \code{\link{cloud_details}()}, 25 | \code{\link{cloud_fetch_results}()}, 26 | \code{\link{cloud_plot}()}, 27 | \code{\link{cloud_report}()}, 28 | \code{\link{cloud_results}()}, 29 | \code{\link{cloud_summary}()} 30 | } 31 | \concept{cloud} 32 | -------------------------------------------------------------------------------- /man/cloud_browse.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cloud.R 3 | \name{cloud_browse} 4 | \alias{cloud_browse} 5 | \title{Browse to the AWS url for the job} 6 | \usage{ 7 | cloud_browse(job_name = cloud_job(), package = NULL) 8 | } 9 | \arguments{ 10 | \item{job_name}{The job name, as returned by \code{\link[=cloud_check]{cloud_check()}}.} 11 | 12 | \item{package}{If \code{NULL} browses to the URL of the overall job. If a package 13 | name, browses to the URL for that specific package job.} 14 | } 15 | \description{ 16 | This is useful for closer inspection of individual jobs while they are 17 | running or after the fact. 18 | } 19 | \seealso{ 20 | Other cloud: 21 | \code{\link{cloud_broken}()}, 22 | \code{\link{cloud_cancel}()}, 23 | \code{\link{cloud_check}()}, 24 | \code{\link{cloud_details}()}, 25 | \code{\link{cloud_fetch_results}()}, 26 | \code{\link{cloud_plot}()}, 27 | \code{\link{cloud_report}()}, 28 | \code{\link{cloud_results}()}, 29 | \code{\link{cloud_status}()}, 30 | \code{\link{cloud_summary}()} 31 | } 32 | \concept{cloud} 33 | -------------------------------------------------------------------------------- /man/cloud_fetch_results.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cloud.R 3 | \name{cloud_fetch_results} 4 | \alias{cloud_fetch_results} 5 | \title{Fetch results from the cloud} 6 | \usage{ 7 | cloud_fetch_results(job_name = cloud_job(pkg = pkg), pkg = ".") 8 | } 9 | \arguments{ 10 | \item{job_name}{The job name, as returned by \code{\link[=cloud_check]{cloud_check()}}.} 11 | 12 | \item{pkg}{Path to package.} 13 | } 14 | \description{ 15 | Intended mainly for internal and expert use. This function when needed by 16 | \code{\link[=cloud_report]{cloud_report()}} and \code{\link[=cloud_summary]{cloud_summary()}}, so it is unlikely you will need to 17 | call it explicitly. 18 | } 19 | \seealso{ 20 | Other cloud: 21 | \code{\link{cloud_broken}()}, 22 | \code{\link{cloud_browse}()}, 23 | \code{\link{cloud_cancel}()}, 24 | \code{\link{cloud_check}()}, 25 | \code{\link{cloud_details}()}, 26 | \code{\link{cloud_plot}()}, 27 | \code{\link{cloud_report}()}, 28 | \code{\link{cloud_results}()}, 29 | \code{\link{cloud_status}()}, 30 | \code{\link{cloud_summary}()} 31 | } 32 | \concept{cloud} 33 | \keyword{internal} 34 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | # MIT License 2 | 3 | Copyright (c) 2020 revdepcheck 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 | -------------------------------------------------------------------------------- /R/report-checklist.R: -------------------------------------------------------------------------------- 1 | revdep_report_checklist <- function(pkg, results, file = "") { 2 | worse <- map_lgl(results, \(x) any(x$cmp$change == 1)) 3 | problems <- results[worse] 4 | 5 | for (problem in problems) { 6 | url <- pkg_links(problem)[[1]] 7 | cat_glue("* [ ] [{problem$package}]({url}) \u2014 ", file = file) 8 | } 9 | } 10 | 11 | # Create a vector of links in order of desirability 12 | pkg_links <- function(result) { 13 | links <- list() 14 | 15 | desc <- tryCatch( 16 | desc::desc(text = result$new$description), 17 | error = function(x) NULL 18 | ) 19 | if (!is.null(desc)) { 20 | links[["GitHub"]] <- pkg_github(desc) 21 | 22 | maintainer <- desc$get_maintainer() 23 | email <- rematch2::re_match(maintainer, "<(.+)>")[[1]] 24 | if (!is.na(email)) { 25 | links[["Email"]] <- paste0("mailto:", email) 26 | } 27 | } 28 | 29 | if (isTRUE(result$new$cran)) { 30 | links[["GitHub mirror"]] <- paste0( 31 | "https://github.com/cran/", 32 | result$package 33 | ) 34 | } 35 | 36 | if (length(links) == 0) { 37 | # Should never get here, but just in case 38 | "UNKNOWN" 39 | } else { 40 | unlist(links) 41 | } 42 | } 43 | -------------------------------------------------------------------------------- /inst/templates/email-failed.txt: -------------------------------------------------------------------------------- 1 | Dear {your_name}, 2 | 3 | This is an automated email to let you know that: 4 | 5 | * A new version of {my_package} is ready to go to CRAN. {my_package} is 6 | currently at version {my_version} and will become {release_version} upon release. 7 | 8 | * {your_package} uses {my_package}, but I could not automatically check it. 9 | 10 | * We plan to submit {my_package} to CRAN on {release_date}. 11 | 12 | I need your help to keep {your_package} and {my_package} working together smoothly. In the next {rel_release_date}, can you please run R CMD check on your package using the development version of {my_package}. You can see at list of changes at {my_news_url}. 13 | 14 | If you discover any failing checks, either update your package, or inform me that you have found a potential bug in {my_package}. 15 | 16 | * If you update your package, please submit an update to CRAN before {release_date}. 17 | 18 | * If you have discovered a bug in {my_package}, please file an issue (ideally 19 | with a small reprex that illustrates the problem) at {my_issues_url}. 20 | 21 | * If you're not sure whether or not you've found a bug, please an issue and 22 | we'll help you figure it out. 23 | 24 | Thanks, 25 | 26 | {my_name} 27 | -------------------------------------------------------------------------------- /man/revdep_add.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/todo.R 3 | \name{revdep_add} 4 | \alias{revdep_add} 5 | \alias{revdep_add_broken} 6 | \alias{revdep_add_new} 7 | \alias{revdep_todo} 8 | \alias{revdep_rm} 9 | \title{Manage the package checking to-do list.} 10 | \usage{ 11 | revdep_add(pkg = ".", packages) 12 | 13 | revdep_add_broken( 14 | pkg = ".", 15 | install_failures = FALSE, 16 | timeout_failures = FALSE 17 | ) 18 | 19 | revdep_add_new(pkg = ".") 20 | 21 | revdep_todo(pkg = ".") 22 | 23 | revdep_rm(pkg = ".", packages) 24 | } 25 | \arguments{ 26 | \item{pkg}{Path to package.} 27 | 28 | \item{packages}{Character vector of package names to add} 29 | 30 | \item{install_failures}{Whether to re-add packages that failed to 31 | install.} 32 | 33 | \item{timeout_failures}{Whether to re-add packages that timed out.} 34 | } 35 | \description{ 36 | \code{revdep_todo()} tells you which packages still need to be checked. 37 | \code{revdep_add()} adds a single package to the to-do list. 38 | \code{revdep_rm()} removes packages from the todo list. 39 | \code{revdep_add_broken()} re-adds all broken packages from the last check 40 | (this is useful if you think you've fixed the underlying problem in 41 | your package). 42 | } 43 | -------------------------------------------------------------------------------- /.github/workflows/pkgdown.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 | release: 8 | types: [published] 9 | workflow_dispatch: 10 | 11 | name: pkgdown.yaml 12 | 13 | permissions: read-all 14 | 15 | jobs: 16 | pkgdown: 17 | runs-on: ubuntu-latest 18 | # Only restrict concurrency for non-PR jobs 19 | concurrency: 20 | group: pkgdown-${{ github.event_name != 'pull_request' || github.run_id }} 21 | env: 22 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 23 | permissions: 24 | contents: write 25 | steps: 26 | - uses: actions/checkout@v4 27 | 28 | - uses: r-lib/actions/setup-pandoc@v2 29 | 30 | - uses: r-lib/actions/setup-r@v2 31 | with: 32 | use-public-rspm: true 33 | 34 | - uses: r-lib/actions/setup-r-dependencies@v2 35 | with: 36 | extra-packages: any::pkgdown, local::. 37 | needs: website 38 | 39 | - name: Build site 40 | run: pkgdown::build_site_github_pages(new_process = FALSE, install = FALSE) 41 | shell: Rscript {0} 42 | 43 | - name: Deploy to GitHub pages 🚀 44 | if: github.event_name != 'pull_request' 45 | uses: JamesIves/github-pages-deploy-action@v4.5.0 46 | with: 47 | clean: false 48 | branch: gh-pages 49 | folder: docs 50 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # 1.0.0.9002 2 | 3 | * Add `cran` parameter to the `get_repos()` internal and propagate it to the 4 | upstream functions including `revdep_check()`. It allow user to decide 5 | whether htey want to always append CRAN mirror to repos or not (@maksymis) 6 | 7 | * `cloud_check(r_version = "4.4.0")` is the updated default. 8 | 9 | # revdepcheck (development version) 10 | 11 | * `cloud_check(r_version = "4.3.1")` is the updated default (#361). 12 | 13 | * `cloud_check()` gains the ability to check Bioconductor packages via a new 14 | `bioc` argument, with a default of `FALSE` due to a relatively high likelihood 15 | of failed checks since Bioconductor system dependencies are currently not 16 | installed in the cloud check service (#362, #369). 17 | 18 | * updated pkgdown template and url to https://revdepcheck.r-lib.org. 19 | 20 | * `cloud_check()` gains the ability to add additional packages as the source 21 | of reverse dependencies. 22 | 23 | * `cran_revdeps()` now accepts multiple packge names. 24 | 25 | * `cloud_results()` gains a progress bar so you can see what's happening 26 | for large revdep runs (#273) 27 | 28 | * `cloud_report()` can opt-out of saving failures, and saves the CRAN report 29 | the same way as `revdep_report()` (#271). 30 | 31 | * `revdep_report()` now saves the results of `revdep_report_cran()` to 32 | `revdep/cran.md` (#204) 33 | 34 | * Exported `revdep_report()` to write the current results to README.md 35 | and problems.md. 36 | 37 | 38 | # revdepcheck 1.0.0 39 | 40 | First public release. 41 | -------------------------------------------------------------------------------- /man/cloud_broken.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cloud.R 3 | \name{cloud_broken} 4 | \alias{cloud_broken} 5 | \alias{cloud_failed} 6 | \title{Retrieve the names broken or failed packages} 7 | \usage{ 8 | cloud_broken( 9 | job_name = cloud_job(pkg = pkg), 10 | pkg = ".", 11 | install_failures = FALSE, 12 | timeout_failures = FALSE 13 | ) 14 | 15 | cloud_failed(job_name = cloud_job(pkg = pkg), pkg = ".") 16 | } 17 | \arguments{ 18 | \item{job_name}{The job name, as returned by \code{\link[=cloud_check]{cloud_check()}}.} 19 | 20 | \item{pkg}{Path to package.} 21 | 22 | \item{install_failures}{Whether to include packages that failed to install.} 23 | 24 | \item{timeout_failures}{Whether to include packages that timed out.} 25 | } 26 | \value{ 27 | A character vector with the names of broken packages, to be passed to \code{cloud_check()}. 28 | } 29 | \description{ 30 | Broken packages are those whose checks got worse with the dev version. 31 | Failed packages are those whose cloud jobs failed, either because the spot 32 | instance was shut down by AWS or because the checks used too much memory and 33 | were killed. 34 | } 35 | \seealso{ 36 | Other cloud: 37 | \code{\link{cloud_browse}()}, 38 | \code{\link{cloud_cancel}()}, 39 | \code{\link{cloud_check}()}, 40 | \code{\link{cloud_details}()}, 41 | \code{\link{cloud_fetch_results}()}, 42 | \code{\link{cloud_plot}()}, 43 | \code{\link{cloud_report}()}, 44 | \code{\link{cloud_results}()}, 45 | \code{\link{cloud_status}()}, 46 | \code{\link{cloud_summary}()} 47 | } 48 | \concept{cloud} 49 | -------------------------------------------------------------------------------- /inst/templates/email-broken.txt: -------------------------------------------------------------------------------- 1 | Dear {your_name}, 2 | 3 | This is an automated email to let you know that: 4 | 5 | * A new version of {my_package} is ready to go to CRAN. {my_package} is 6 | currently at version {my_version} and will become {release_version} upon release. 7 | 8 | * {your_package} uses {my_package} and has problems with the new version. 9 | 10 | * We plan to submit {my_package} to CRAN on {release_date}. 11 | 12 | {release_details} 13 | 14 | I need your help to keep {your_package} and {my_package} working together smoothly. In the next {rel_release_date}, can you please: 15 | 16 | 1. Read about the changes to {my_package} at 17 | {my_news_url}. 18 | This page includes a list of breaking changes, the reasoning behind 19 | them, and to how to update your code. 20 | 21 | 2. Carefully inspect the failing checks listed at the bottom of this email. 22 | 23 | 3. For each failing check, either update your package, or tell me 24 | that I have a bug. If you have made changes to your package, please 25 | submit an update to CRAN before {release_date}. 26 | 27 | If you have discovered a bug in {my_package}, please file an issue (ideally with a small reprex that illustrates the problem) at {my_issues_url}. If you're not sure whether or not you've found a bug, please file an issue at {my_issues_url} for discussion. Breaking changes that are not listed qualify as bugs. 28 | 29 | Please respond to this message if you have any questions. 30 | 31 | 32 | Thanks, 33 | 34 | {my_name} 35 | 36 | == CHECK RESULTS ======================================== 37 | 38 | {your_results} 39 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: revdepcheck 2 | Title: Automated Reverse Dependency Checking 3 | Version: 1.0.0.9002 4 | Authors@R: c( 5 | person("Gábor", "Csárdi", , "csardi.gabor@gmail.com", role = c("cre", "aut", "cph")), 6 | person("Hadley", "Wickham", role = "aut"), 7 | person("RConsortium", role = "cph"), 8 | person("RStudio", role = c("cph", "fnd")) 9 | ) 10 | Description: Automated, isolated reserve dependency checking, with 11 | automatic comparison of the results to the current CRAN checks. 12 | License: MIT + file LICENSE 13 | URL: https://revdepcheck.r-lib.org, 14 | https://github.com/r-lib/revdepcheck#readme 15 | BugReports: https://github.com/r-lib/revdepcheck/issues 16 | Imports: 17 | assertthat, 18 | brio, 19 | callr, 20 | cli (>= 3.1.0), 21 | clisymbols, 22 | crancache (>= 0.0.0.9001), 23 | crayon (>= 1.4.1), 24 | curl, 25 | DBI, 26 | desc (>= 1.3.0), 27 | glue, 28 | gmailr, 29 | hms, 30 | httr, 31 | jsonlite, 32 | knitr, 33 | pkgbuild, 34 | prettyunits, 35 | processx (>= 3.3.0), 36 | progress, 37 | rcmdcheck (>= 1.3.3), 38 | rematch2, 39 | remotes (>= 2.2.0), 40 | rlang (>= 0.3.0), 41 | RSQLite, 42 | sessioninfo, 43 | tibble, 44 | utils, 45 | whoami, 46 | withr, 47 | yaml 48 | Suggests: 49 | covr, 50 | debugme, 51 | forcats, 52 | ggplot2, 53 | rmarkdown, 54 | testthat 55 | VignetteBuilder: 56 | knitr 57 | Remotes: 58 | r-lib/crancache, 59 | r-lib/remotes 60 | Config/Needs/website: tidyverse/tidytemplate 61 | Encoding: UTF-8 62 | LazyData: true 63 | Roxygen: list(markdown = TRUE) 64 | RoxygenNote: 7.3.3 65 | -------------------------------------------------------------------------------- /man/cloud_email.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cloud.R 3 | \name{cloud_email} 4 | \alias{cloud_email} 5 | \title{Notify revdep maintainers about problems} 6 | \usage{ 7 | cloud_email( 8 | type = c("broken", "failed"), 9 | job_name = cloud_job(pkg = pkg), 10 | pkg = ".", 11 | packages = NULL, 12 | draft = FALSE 13 | ) 14 | } 15 | \arguments{ 16 | \item{type}{Type of problems to notify about; either "broken" (i.e. there 17 | is a new \verb{R CMD check} failure that did not currently occur) or 18 | "failed" (i.e. the check failure either during installation or because 19 | of a timeout).} 20 | 21 | \item{job_name}{The job name, as returned by \code{\link[=cloud_check]{cloud_check()}}.} 22 | 23 | \item{pkg}{Path to package.} 24 | 25 | \item{packages}{A character vector of package names. Use this if some emails 26 | failed to send in the previous round. If omitted uses all packages.} 27 | 28 | \item{draft}{If \code{TRUE}, create a gmail draft rather than sending the email 29 | directly.} 30 | } 31 | \description{ 32 | This function uses gmail to automatically notify all maintainers of revdeps 33 | that have failures with the new version of the package. The form of the 34 | email is fixed, but it uses template parameters so that you can control 35 | the details: set the variables in \code{revdeps/email.yaml}. You'll be prompted to 36 | review the template before any emails are sent; or you can use 37 | \code{revdep_email_draft()} to see a draft version. 38 | } 39 | \details{ 40 | To use this function, you'll need to give the gmailr app authority to 41 | send emails from gmail. To revoke that authority, delete the \code{.httr-oauth} 42 | file created in your working directory. 43 | } 44 | -------------------------------------------------------------------------------- /man/revdep_email.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/email.R 3 | \name{revdep_email} 4 | \alias{revdep_email} 5 | \alias{revdep_email_draft} 6 | \title{Notify revdep maintainers about problems} 7 | \usage{ 8 | revdep_email( 9 | type = c("broken", "failed"), 10 | pkg = ".", 11 | packages = NULL, 12 | draft = FALSE 13 | ) 14 | 15 | revdep_email_draft(type = "broken", pkg = ".", data = email_data(pkg)) 16 | } 17 | \arguments{ 18 | \item{type}{Type of problems to notify about; either "broken" (i.e. there 19 | is a new \verb{R CMD check} failure that did not currently occur) or 20 | "failed" (i.e. the check failure either during installation or because 21 | of a timeout).} 22 | 23 | \item{pkg}{Path to package.} 24 | 25 | \item{packages}{A character vector of package names. Use this if some emails 26 | failed to send in the previous round. If omitted uses all packages.} 27 | 28 | \item{draft}{If \code{TRUE}, create a gmail draft rather than sending the email 29 | directly.} 30 | 31 | \item{data}{Optionally, supply a named list to provide your own parameters 32 | to fill in the template} 33 | } 34 | \description{ 35 | This function uses gmail to automatically notify all maintainers of revdeps 36 | that have failures with the new version of the package. The form of the 37 | email is fixed, but it uses template parameters so that you can control 38 | the details: set the variables in \code{revdeps/email.yaml}. You'll be prompted to 39 | review the template before any emails are sent; or you can use 40 | \code{revdep_email_draft()} to see a draft version. 41 | } 42 | \details{ 43 | To use this function, you'll need to give the gmailr app authority to 44 | send emails from gmail. To revoke that authority, delete the \code{.httr-oauth} 45 | file created in your working directory. 46 | } 47 | -------------------------------------------------------------------------------- /man/run_event_loop.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/event-loop.R 3 | \name{run_event_loop} 4 | \alias{run_event_loop} 5 | \title{This is the event loop of the revdep check process} 6 | \usage{ 7 | run_event_loop(state) 8 | } 9 | \arguments{ 10 | \item{state}{The full state of the check process: 11 | \itemize{ 12 | \item \code{options} contains all check parameters. 13 | \item \code{packages} is a data frame with the packages to check. 14 | See details below. 15 | }} 16 | } 17 | \description{ 18 | This is the event loop of the revdep check process 19 | } 20 | \details{ 21 | \code{state$packages} is a data frame with columns: 22 | \itemize{ 23 | \item \code{package}: the name of the package 24 | \item \code{state}: where we are with its check. Possible values: 25 | \itemize{ 26 | \item \code{todo}: haven't done anything yet 27 | \item \code{deps_installing}: the dependencies are being installed now 28 | \item \code{deps_installed}: the dependencies were already installed 29 | \item \code{downloading}: the source package to check is being downloaded 30 | \item \code{downloaded}: the source package was downloaded 31 | \item \code{checking}: checking with the old version right now 32 | \item \code{checking-checking}: checking with both versions right now 33 | \item \code{done-checking}: done with the old version, checking with the new 34 | version right now 35 | \item \code{checking-done}: checking with the old version, new version was 36 | already done. 37 | \item \code{done-downloaded}: done with the old version, check with new 38 | version has not started yet 39 | \item \code{done}: packages was checked with both versions 40 | } 41 | } 42 | 43 | We only start the check with the new version after the check with the 44 | old version, which simplifies the state transitions a bit. 45 | } 46 | \keyword{internal} 47 | -------------------------------------------------------------------------------- /man/cloud_check.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cloud.R 3 | \name{cloud_check} 4 | \alias{cloud_check} 5 | \title{Submit a reverse dependency checking job to the cloud} 6 | \usage{ 7 | cloud_check( 8 | pkg = ".", 9 | tarball = NULL, 10 | revdep_packages = NULL, 11 | extra_revdeps = NULL, 12 | r_version = "4.4.0", 13 | check_args = "--no-manual", 14 | bioc = FALSE 15 | ) 16 | } 17 | \arguments{ 18 | \item{pkg}{Path to package.} 19 | 20 | \item{tarball}{A pre-built package tarball, if \code{NULL} a tarball will be 21 | automatically built for the package at \code{pkg} by \code{\link[pkgbuild:build]{pkgbuild::build()}}.} 22 | 23 | \item{revdep_packages}{A character vector of packages to check, if \code{NULL} 24 | equal to \code{\link[=cran_revdeps]{cran_revdeps()}}} 25 | 26 | \item{extra_revdeps}{Additional packages to use as source for reverse 27 | dependencies.} 28 | 29 | \item{r_version}{The R version to use.} 30 | 31 | \item{check_args}{Additional argument to pass to \verb{R CMD check}} 32 | 33 | \item{bioc}{Also check revdeps that live in Bioconductor? Default \code{FALSE}. 34 | Note that the cloud revdep check service does not currently include system 35 | dependencies of Bioconductor packages, so there is potential for more 36 | failed checks.} 37 | } 38 | \value{ 39 | The AWS Batch job name 40 | } 41 | \description{ 42 | Submit a reverse dependency checking job to the cloud 43 | } 44 | \seealso{ 45 | Other cloud: 46 | \code{\link{cloud_broken}()}, 47 | \code{\link{cloud_browse}()}, 48 | \code{\link{cloud_cancel}()}, 49 | \code{\link{cloud_details}()}, 50 | \code{\link{cloud_fetch_results}()}, 51 | \code{\link{cloud_plot}()}, 52 | \code{\link{cloud_report}()}, 53 | \code{\link{cloud_results}()}, 54 | \code{\link{cloud_status}()}, 55 | \code{\link{cloud_summary}()} 56 | } 57 | \concept{cloud} 58 | -------------------------------------------------------------------------------- /.github/workflows/format-suggest.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/posit-dev/setup-air/tree/main/examples 2 | 3 | on: 4 | # Using `pull_request_target` over `pull_request` for elevated `GITHUB_TOKEN` 5 | # privileges, otherwise we can't set `pull-requests: write` when the pull 6 | # request comes from a fork, which is our main use case (external contributors). 7 | # 8 | # `pull_request_target` runs in the context of the target branch (`main`, usually), 9 | # rather than in the context of the pull request like `pull_request` does. Due 10 | # to this, we must explicitly checkout `ref: ${{ github.event.pull_request.head.sha }}`. 11 | # This is typically frowned upon by GitHub, as it exposes you to potentially running 12 | # untrusted code in a context where you have elevated privileges, but they explicitly 13 | # call out the use case of reformatting and committing back / commenting on the PR 14 | # as a situation that should be safe (because we aren't actually running the untrusted 15 | # code, we are just treating it as passive data). 16 | # https://securitylab.github.com/resources/github-actions-preventing-pwn-requests/ 17 | pull_request_target: 18 | 19 | name: format-suggest.yaml 20 | 21 | jobs: 22 | format-suggest: 23 | name: format-suggest 24 | runs-on: ubuntu-latest 25 | 26 | permissions: 27 | # Required to push suggestion comments to the PR 28 | pull-requests: write 29 | 30 | steps: 31 | - uses: actions/checkout@v4 32 | with: 33 | ref: ${{ github.event.pull_request.head.sha }} 34 | 35 | - name: Install 36 | uses: posit-dev/setup-air@v1 37 | 38 | - name: Format 39 | run: air format . 40 | 41 | - name: Suggest 42 | uses: reviewdog/action-suggester@v1 43 | with: 44 | level: error 45 | fail_level: error 46 | tool_name: air 47 | -------------------------------------------------------------------------------- /man/revdep_report_summary.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/report.R 3 | \name{revdep_report_summary} 4 | \alias{revdep_report_summary} 5 | \alias{revdep_report_problems} 6 | \alias{revdep_report_failures} 7 | \alias{revdep_report_cran} 8 | \alias{revdep_report} 9 | \title{Markdown report of reverse dependency check results} 10 | \usage{ 11 | revdep_report_summary(pkg = ".", file = "", all = FALSE, results = NULL) 12 | 13 | revdep_report_problems( 14 | pkg = ".", 15 | file = "", 16 | all = FALSE, 17 | results = NULL, 18 | bioc = TRUE, 19 | cran = TRUE 20 | ) 21 | 22 | revdep_report_failures( 23 | pkg = ".", 24 | file = "", 25 | results = NULL, 26 | bioc = TRUE, 27 | cran = TRUE 28 | ) 29 | 30 | revdep_report_cran(pkg = ".", file = "", results = NULL) 31 | 32 | revdep_report(pkg = ".", all = FALSE, results = NULL, bioc = TRUE, cran = TRUE) 33 | } 34 | \arguments{ 35 | \item{pkg}{Path to package.} 36 | 37 | \item{file}{File to write output to. Default will write to console.} 38 | 39 | \item{all}{Whether to report all problems, including the ones that 40 | were already present in the old version of the package. This potentially 41 | generated a lot of output, most of which was irrelevant, so they are 42 | omitted by default, and only problems seen with the new version of 43 | the package are reported.} 44 | 45 | \item{results}{Cached results from \code{db_results()}. Expert use only.} 46 | 47 | \item{bioc}{Also check revdeps that live in Bioconductor?} 48 | 49 | \item{cran}{Should cran mirror be attached to getOpion("repos") if it 50 | is not already present.} 51 | } 52 | \description{ 53 | You can use these functions to get intermediate reports of a \code{\link[=revdep_check]{revdep_check()}} 54 | running in another session. 55 | } 56 | \details{ 57 | \code{revdep_report_summary()} writes the contents of \code{README.md}, by 58 | default to the console. This is handy to quickly inspect the (current) 59 | list of problematic packages. 60 | } 61 | -------------------------------------------------------------------------------- /.github/workflows/test-coverage.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 | 8 | name: test-coverage.yaml 9 | 10 | permissions: read-all 11 | 12 | jobs: 13 | test-coverage: 14 | runs-on: ubuntu-latest 15 | env: 16 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 17 | 18 | steps: 19 | - uses: actions/checkout@v4 20 | 21 | - uses: r-lib/actions/setup-r@v2 22 | with: 23 | use-public-rspm: true 24 | 25 | - uses: r-lib/actions/setup-r-dependencies@v2 26 | with: 27 | extra-packages: any::covr, any::xml2 28 | needs: coverage 29 | 30 | - name: Test coverage 31 | run: | 32 | cov <- covr::package_coverage( 33 | quiet = FALSE, 34 | clean = FALSE, 35 | install_path = file.path(normalizePath(Sys.getenv("RUNNER_TEMP"), winslash = "/"), "package") 36 | ) 37 | print(cov) 38 | covr::to_cobertura(cov) 39 | shell: Rscript {0} 40 | 41 | - uses: codecov/codecov-action@v5 42 | with: 43 | # Fail if error if not on PR, or if on PR and token is given 44 | fail_ci_if_error: ${{ github.event_name != 'pull_request' || secrets.CODECOV_TOKEN }} 45 | files: ./cobertura.xml 46 | plugins: noop 47 | disable_search: true 48 | token: ${{ secrets.CODECOV_TOKEN }} 49 | 50 | - name: Show testthat output 51 | if: always() 52 | run: | 53 | ## -------------------------------------------------------------------- 54 | find '${{ runner.temp }}/package' -name 'testthat.Rout*' -exec cat '{}' \; || true 55 | shell: bash 56 | 57 | - name: Upload test results 58 | if: failure() 59 | uses: actions/upload-artifact@v4 60 | with: 61 | name: coverage-test-failures 62 | path: ${{ runner.temp }}/package 63 | -------------------------------------------------------------------------------- /.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 | # 4 | # NOTE: This workflow is overkill for most R packages and 5 | # check-standard.yaml is likely a better choice. 6 | # usethis::use_github_action("check-standard") will install it. 7 | on: 8 | push: 9 | branches: [main, master] 10 | pull_request: 11 | 12 | name: R-CMD-check.yaml 13 | 14 | permissions: read-all 15 | 16 | jobs: 17 | R-CMD-check: 18 | runs-on: ${{ matrix.config.os }} 19 | 20 | name: ${{ matrix.config.os }} (${{ matrix.config.r }}) 21 | 22 | strategy: 23 | fail-fast: false 24 | matrix: 25 | config: 26 | - {os: macos-latest, r: 'release'} 27 | 28 | - {os: windows-latest, r: 'release'} 29 | # use 4.0 or 4.1 to check with rtools40's older compiler 30 | - {os: windows-latest, r: 'oldrel-4'} 31 | 32 | - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'} 33 | - {os: ubuntu-latest, r: 'release'} 34 | - {os: ubuntu-latest, r: 'oldrel-1'} 35 | - {os: ubuntu-latest, r: 'oldrel-2'} 36 | - {os: ubuntu-latest, r: 'oldrel-3'} 37 | - {os: ubuntu-latest, r: 'oldrel-4'} 38 | 39 | env: 40 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 41 | R_KEEP_PKG_SOURCE: yes 42 | 43 | steps: 44 | - uses: actions/checkout@v4 45 | 46 | - uses: r-lib/actions/setup-pandoc@v2 47 | 48 | - uses: r-lib/actions/setup-r@v2 49 | with: 50 | r-version: ${{ matrix.config.r }} 51 | http-user-agent: ${{ matrix.config.http-user-agent }} 52 | use-public-rspm: true 53 | 54 | - uses: r-lib/actions/setup-r-dependencies@v2 55 | with: 56 | extra-packages: any::rcmdcheck 57 | needs: check 58 | 59 | - uses: r-lib/actions/check-r-package@v2 60 | with: 61 | upload-snapshots: true 62 | build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")' 63 | -------------------------------------------------------------------------------- /R/download.R: -------------------------------------------------------------------------------- 1 | download_opts <- function(pkgdir, pkgname, bioc, cran) { 2 | dir <- dir_find(pkgdir, "check", pkgname) 3 | 4 | func <- function(pkgname, dir, repos) { 5 | dest <- crancache::download_packages(pkgname, dir, repos = repos)[, 2] 6 | file.copy(dest, dir) 7 | } 8 | 9 | r_process_options( 10 | func = func, 11 | args = list( 12 | pkgname = pkgname, 13 | dir = dir, 14 | repos = get_repos(bioc = bioc, cran = cran) 15 | ), 16 | system_profile = FALSE, 17 | user_profile = FALSE, 18 | env = c(CRANCACHE_REPOS = "cran,bioc", CRANCACHE_QUIET = "yes") 19 | ) 20 | } 21 | 22 | download_task <- function(state, task) { 23 | pkgdir <- state$options$pkgdir 24 | pkgname <- task$args[[1]] 25 | bioc <- state$options$bioc 26 | cran <- state$options$cran 27 | 28 | "!DEBUG Downloading source of `pkgname`" 29 | px_opts <- download_opts(pkgdir, pkgname, bioc, cran) 30 | px <- r_process$new(px_opts) 31 | 32 | ## update state 33 | worker <- list( 34 | process = px, 35 | package = pkgname, 36 | stdout = character(), 37 | stderr = character(), 38 | task = task 39 | ) 40 | state$workers <- c(state$workers, list(worker)) 41 | 42 | wpkg <- match(worker$package, state$packages$package) 43 | state$packages$state[wpkg] <- "downloading" 44 | 45 | state 46 | } 47 | 48 | 49 | pkg_tarball <- function(pkgdir, pkgname) { 50 | dir <- dir_find(pkgdir, "check", pkgname) 51 | dir(dir, pattern = "\\.tar\\.gz$", full.names = TRUE) 52 | } 53 | 54 | download_done <- function(state, worker) { 55 | pkgdir <- state$options$pkgdir 56 | pkgname <- worker$task$args[[1]] 57 | 58 | tarball <- pkg_tarball(pkgdir, pkgname) 59 | if (!length(tarball)) { 60 | n_attempts <- worker$task$args[[2]] 61 | if (n_attempts > 20L) { 62 | stop(sprintf("Failed downloading package %s", pkgname), call. = FALSE) 63 | } else { 64 | return(download_task(state, task("download", pkgname, n_attempts + 1L))) 65 | } 66 | } 67 | 68 | wpkg <- match(worker$package, state$packages$package) 69 | state$packages$state[wpkg] <- "downloaded" 70 | state 71 | } 72 | 73 | download <- function(pkgdir, pkgname, new_session = FALSE) { 74 | px_opts <- download_opts(pkgdir, pkgname) 75 | execute_r(px_opts, new_session = new_session) 76 | } 77 | -------------------------------------------------------------------------------- /man/dir_find.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/dirs.R 3 | \name{dir_find} 4 | \alias{dir_find} 5 | \alias{dir_setup} 6 | \alias{dir_setup_package} 7 | \title{Set up/retrieve the directory structure for the checks} 8 | \usage{ 9 | dir_find( 10 | pkgdir, 11 | what = c("root", "db", "old", "new", "pkg", "check", "checks", "lib", "pkgold", 12 | "pkgnew", "cloud"), 13 | package = NULL 14 | ) 15 | 16 | dir_setup(pkgdir) 17 | 18 | dir_setup_package(pkgdir, package) 19 | } 20 | \arguments{ 21 | \item{pkgdir}{Path to the package we are revdep-checking.} 22 | 23 | \item{what}{Directory to query: 24 | \itemize{ 25 | \item \code{"root"}: the root of the check directory, 26 | \item \code{"db"}: the database file, 27 | \item \code{"old"}: the library of the old version of the package. 28 | \item \code{"new"}: the library of the new version of the package. 29 | \item \code{"pkg"}: the library of the reverse dependency, the \code{package} 30 | argument must be supplied as well. 31 | \item \code{"check"}: the check directory of the reverse dependency, the 32 | \code{package} argument must be supplied as well. 33 | \item \code{"pkgold"}: package libraries to use when checking \code{package} with 34 | the old version. 35 | \item \code{"pkgnew"}: package libraries to use when checking \code{package} with 36 | the new version. 37 | }} 38 | 39 | \item{package}{The name of the package, if \code{what} is \code{"pkg"}, \code{"check"}, 40 | \code{"pkgold"} or \code{"pkgnew"}.} 41 | } 42 | \value{ 43 | Character scalar, the requested path. 44 | } 45 | \description{ 46 | Currently the following files and directories are used. 47 | They are all in the main revdep directory, which is \code{revdep} in the 48 | package tree. 49 | \itemize{ 50 | \item \code{library}: a collection of package libraries 51 | \item \code{library/data.sqlite}: the SQLite database that contains the check 52 | data. 53 | \item \verb{library//old}: library that contains the \emph{old} version 54 | of the revdep-checked package, together with its dependencies. 55 | \item \verb{library//new}: library that contains the \emph{new} version 56 | of the revdep-checked package, together with its dependencies. 57 | \item \verb{library/} are the libraries for the reverse dependencies. 58 | } 59 | } 60 | \keyword{internal} 61 | -------------------------------------------------------------------------------- /R/compare.R: -------------------------------------------------------------------------------- 1 | #' @importFrom rcmdcheck compare_checks 2 | 3 | try_compare_checks <- function(package, old, new) { 4 | if (!inherits(old, "rcmdcheck") || !inherits(new, "rcmdcheck")) { 5 | rcmdcheck_error(package, old, new) 6 | } else { 7 | compare_checks(old, new) 8 | } 9 | } 10 | 11 | rcmdcheck_error <- function(package, old, new) { 12 | structure( 13 | list( 14 | package = package, 15 | status = "E", 16 | old = old, 17 | new = new 18 | ), 19 | class = "rcmdcheck_error" 20 | ) 21 | } 22 | 23 | rcmdcheck_status <- function(x) UseMethod("rcmdcheck_status") 24 | #' @export 25 | rcmdcheck_status.rcmdcheck_error <- function(x) "?" 26 | #' @export 27 | rcmdcheck_status.rcmdcheck_comparison <- function(x) x$status 28 | 29 | rcmdcheck_version <- function(x) UseMethod("rcmdcheck_version") 30 | #' @export 31 | rcmdcheck_version.rcmdcheck_error <- function(x) "?" 32 | #' @export 33 | rcmdcheck_version.rcmdcheck_comparison <- function(x) x$versions[[1]] 34 | 35 | is_broken <- function(x, install_failures = FALSE, timeout_failures = FALSE) { 36 | stat <- rcmdcheck_status(x) 37 | stat == "-" || 38 | (install_failures && stat %in% c("i-", "E", "?")) || 39 | (timeout_failures && stat == "t-") 40 | } 41 | 42 | #' @importFrom clisymbols symbol 43 | #' @importFrom crayon make_style bgRed white 44 | #' @export 45 | 46 | summary.rcmdcheck_error <- function(object, ...) { 47 | header <- paste(white(bgRed("E")), object$package, object$version) 48 | 49 | counts <- function(x) { 50 | if (!inherits(x, "rcmdcheck")) { 51 | c("?", "?", "?") 52 | } else { 53 | lhs <- c(length(x$errors), length(x$warnings), length(x$notes)) 54 | } 55 | } 56 | 57 | lhs <- counts(object$old) 58 | rhs <- counts(object$new) 59 | comp <- paste0(lhs, "/", rhs, " ") 60 | 61 | structure( 62 | list(header = header, comp = comp), 63 | class = "rcmdcheck_error_summary" 64 | ) 65 | } 66 | 67 | #' @export 68 | print.rcmdcheck_error_summary <- function(x, ...) { 69 | pale <- make_style("darkgrey") 70 | cat_line(pale(paste0( 71 | col_align(x$header, width = 40), 72 | " ", 73 | symbol$line, 74 | symbol$line, 75 | " ", 76 | "E: ", 77 | red(x$comp[1]), 78 | " | ", 79 | "W: ", 80 | red(x$comp[2]), 81 | " | ", 82 | "N: ", 83 | red(x$comp[3]) 84 | ))) 85 | } 86 | -------------------------------------------------------------------------------- /man/cloud_report.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cloud.R 3 | \name{cloud_report} 4 | \alias{cloud_report} 5 | \alias{cloud_report_summary} 6 | \alias{cloud_report_problems} 7 | \alias{cloud_report_failures} 8 | \alias{cloud_report_cran} 9 | \alias{cloud_report_checklist} 10 | \title{Markdown report of reverse dependency check results from the cloud} 11 | \usage{ 12 | cloud_report( 13 | job_name = cloud_job(pkg = pkg), 14 | pkg = ".", 15 | file = "", 16 | all = FALSE, 17 | results = NULL, 18 | failures = TRUE 19 | ) 20 | 21 | cloud_report_summary( 22 | job_name = cloud_job(pkg = pkg), 23 | file = "", 24 | all = FALSE, 25 | pkg = ".", 26 | results = NULL 27 | ) 28 | 29 | cloud_report_problems( 30 | job_name = cloud_job(pkg = pkg), 31 | pkg = ".", 32 | file = "", 33 | all = FALSE, 34 | results = NULL 35 | ) 36 | 37 | cloud_report_failures( 38 | job_name = cloud_job(pkg = pkg), 39 | pkg = ".", 40 | file = "", 41 | results = NULL 42 | ) 43 | 44 | cloud_report_cran(job_name = cloud_job(pkg = pkg), pkg = ".", results = NULL) 45 | 46 | cloud_report_checklist( 47 | job_name = cloud_job(pkg = pkg), 48 | pkg = ".", 49 | results = NULL 50 | ) 51 | } 52 | \arguments{ 53 | \item{job_name}{The job name, as returned by \code{\link[=cloud_check]{cloud_check()}}.} 54 | 55 | \item{pkg}{Path to package.} 56 | 57 | \item{file}{File to write output to. Default will write to console.} 58 | 59 | \item{all}{Whether to report all problems, including the ones that 60 | were already present in the old version of the package. This potentially 61 | generated a lot of output, most of which was irrelevant, so they are 62 | omitted by default, and only problems seen with the new version of 63 | the package are reported.} 64 | 65 | \item{results}{Results from \code{\link[=cloud_results]{cloud_results()}}. Expert use only.} 66 | 67 | \item{failures}{Save failures to disk?} 68 | } 69 | \description{ 70 | You can use these functions to get intermediate reports of a running cloud check. 71 | } 72 | \seealso{ 73 | Other cloud: 74 | \code{\link{cloud_broken}()}, 75 | \code{\link{cloud_browse}()}, 76 | \code{\link{cloud_cancel}()}, 77 | \code{\link{cloud_check}()}, 78 | \code{\link{cloud_details}()}, 79 | \code{\link{cloud_fetch_results}()}, 80 | \code{\link{cloud_plot}()}, 81 | \code{\link{cloud_results}()}, 82 | \code{\link{cloud_status}()}, 83 | \code{\link{cloud_summary}()} 84 | } 85 | \concept{cloud} 86 | -------------------------------------------------------------------------------- /R/results.R: -------------------------------------------------------------------------------- 1 | #' Display revdep results 2 | #' 3 | #' Use this to see nicely formatted results of processed packages while 4 | #' [revdep_check()] is running in another process. `revdep_summary()` 5 | #' displays summary results for all complete checks. `revdep_details()` 6 | #' shows you the details for one 7 | #' 8 | #' @export 9 | #' @param pkg Path to package 10 | #' @param revdep Name of revdep package. 11 | 12 | revdep_details <- function(pkg = ".", revdep) { 13 | assert_that(is_string(revdep)) 14 | 15 | structure( 16 | db_results(pkg, revdep)[[1]], 17 | class = "revdepcheck_details" 18 | ) 19 | } 20 | 21 | #' @export 22 | 23 | print.revdepcheck_results <- function(x, ...) { 24 | for (package in x) { 25 | print(summary(package)) 26 | } 27 | invisible(x) 28 | } 29 | 30 | #' @export 31 | #' @rdname revdep_details 32 | 33 | revdep_summary <- function(pkg = ".") { 34 | structure( 35 | db_results(pkg, NULL), 36 | class = "revdepcheck_results" 37 | ) 38 | } 39 | 40 | #' @export 41 | #' @importFrom cli rule 42 | #' @importFrom crayon cyan 43 | 44 | print.revdepcheck_details <- function(x, ...) { 45 | ## Header 46 | cat_rule( 47 | left = cyan("Reverse dependency check"), 48 | right = cyan(x$package, x$versions[[1]]), 49 | line_col = "cyan", 50 | line = 2 51 | ) 52 | 53 | ## First a summary 54 | cat_line() 55 | print(structure(x, class = "rcmdcheck_comparison"), header = FALSE) 56 | 57 | ## Old version 58 | cat_rule(left = "Before") 59 | if (inherits(x$old, "error")) { 60 | cat_line(red("")) 61 | } else { 62 | print(x$old[[1]], header = FALSE) 63 | print_install_out(x$old[[1]]) 64 | } 65 | cat_line() 66 | 67 | ## New version 68 | cat_rule(left = "After") 69 | if (inherits(x$new, "error")) { 70 | cat_line(red("")) 71 | } else { 72 | print(x$new, header = FALSE) 73 | print_install_out(x$new) 74 | } 75 | } 76 | 77 | #' @importFrom rcmdcheck check_details 78 | #' @importFrom utils tail 79 | 80 | print_install_out <- function(x) { 81 | details <- check_details(x) 82 | if ( 83 | any(grepl( 84 | "Installation failed.*00install.out.*for details", 85 | details$errors 86 | )) 87 | ) { 88 | out <- strsplit(details$install_out, "\n")[[1]] 89 | cat("\n", symbol$line, symbol$line, sep = "") 90 | if (length(out) > 15) { 91 | cat(" 'install.out' contents (last 13 lines):\n") 92 | out <- c("...", tail(out, 13)) 93 | } else { 94 | cat(" 'install.out' contents:\n") 95 | } 96 | cat(out, sep = "\n") 97 | } 98 | } 99 | -------------------------------------------------------------------------------- /R/todo.R: -------------------------------------------------------------------------------- 1 | #' Manage the package checking to-do list. 2 | #' 3 | #' `revdep_todo()` tells you which packages still need to be checked. 4 | #' `revdep_add()` adds a single package to the to-do list. 5 | #' `revdep_rm()` removes packages from the todo list. 6 | 7 | #' `revdep_add_broken()` re-adds all broken packages from the last check 8 | #' (this is useful if you think you've fixed the underlying problem in 9 | #' your package). 10 | #' 11 | #' @inheritParams revdep_check 12 | #' @param packages Character vector of package names to add 13 | #' @param install_failures Whether to re-add packages that failed to 14 | #' install. 15 | #' @param timeout_failures Whether to re-add packages that timed out. 16 | #' 17 | #' @export 18 | 19 | revdep_add <- function(pkg = ".", packages) { 20 | pkg <- pkg_check(pkg) 21 | 22 | db_todo_add(pkg, packages, silent = FALSE) 23 | 24 | # If you're re-checking packages, it's because the package has 25 | # changed, so you'll want to re-install it 26 | db_metadata_set(pkg, "todo", "install") 27 | 28 | invisible(revdep_todo(pkg)) 29 | } 30 | 31 | #' @export 32 | #' @rdname revdep_add 33 | 34 | revdep_add_broken <- function( 35 | pkg = ".", 36 | install_failures = FALSE, 37 | timeout_failures = FALSE 38 | ) { 39 | pkg <- pkg_check(pkg) 40 | 41 | packages <- db_results(pkg, NULL) 42 | broken <- map_lgl(packages, is_broken, install_failures, timeout_failures) 43 | 44 | to_add <- names(broken[broken]) 45 | if (length(packages) == 0) { 46 | message("No broken packages to re-test") 47 | } else { 48 | revdep_add(pkg, to_add) 49 | } 50 | 51 | invisible(revdep_todo(pkg)) 52 | } 53 | 54 | #' @export 55 | #' @rdname revdep_add 56 | 57 | revdep_add_new <- function(pkg = ".") { 58 | pkg <- pkg_check(pkg) 59 | 60 | pkgname <- db_metadata_get(pkg, "package") 61 | bioc <- db_metadata_get(pkg, "bioc") %|0|% "TRUE" 62 | dependencies <- db_metadata_get(pkg, "dependencies") %|0|% 63 | "Depends;Imports;Suggests;LinkingTo" 64 | bioc <- as.logical(bioc) 65 | dependencies <- strsplit(dependencies, ";", fixed = TRUE)[[1]] 66 | 67 | revdeps <- cran_revdeps_versions(pkgname, dependencies, bioc = bioc) 68 | 69 | todo <- db_todo_add_new(pkg, revdeps, silent = FALSE) 70 | if (length(todo)) { 71 | db_metadata_set(pkg, "todo", "install") 72 | } 73 | 74 | invisible(revdep_todo(pkg)) 75 | } 76 | 77 | #' @export 78 | #' @rdname revdep_add 79 | 80 | revdep_todo <- function(pkg = ".") { 81 | db_todo_status(pkg) 82 | } 83 | 84 | #' @export 85 | #' @rdname revdep_add 86 | 87 | revdep_rm <- function(pkg = ".", packages) { 88 | pkg <- pkg_check(pkg) 89 | db_todo_rm(pkg, packages) 90 | 91 | invisible(revdep_todo(pkg)) 92 | } 93 | -------------------------------------------------------------------------------- /.github/workflows/pr-commands.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 | issue_comment: 5 | types: [created] 6 | 7 | name: Commands 8 | 9 | jobs: 10 | document: 11 | if: ${{ github.event.issue.pull_request && (github.event.comment.author_association == 'MEMBER' || github.event.comment.author_association == 'OWNER') && startsWith(github.event.comment.body, '/document') }} 12 | name: document 13 | runs-on: ubuntu-latest 14 | env: 15 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 16 | steps: 17 | - uses: actions/checkout@v4 18 | 19 | - uses: r-lib/actions/pr-fetch@v2 20 | with: 21 | repo-token: ${{ secrets.GITHUB_TOKEN }} 22 | 23 | - uses: r-lib/actions/setup-r@v2 24 | with: 25 | use-public-rspm: true 26 | 27 | - uses: r-lib/actions/setup-r-dependencies@v2 28 | with: 29 | extra-packages: any::roxygen2 30 | needs: pr-document 31 | 32 | - name: Document 33 | run: roxygen2::roxygenise() 34 | shell: Rscript {0} 35 | 36 | - name: commit 37 | run: | 38 | git config --local user.name "$GITHUB_ACTOR" 39 | git config --local user.email "$GITHUB_ACTOR@users.noreply.github.com" 40 | git add man/\* NAMESPACE 41 | git commit -m 'Document' 42 | 43 | - uses: r-lib/actions/pr-push@v2 44 | with: 45 | repo-token: ${{ secrets.GITHUB_TOKEN }} 46 | 47 | style: 48 | if: ${{ github.event.issue.pull_request && (github.event.comment.author_association == 'MEMBER' || github.event.comment.author_association == 'OWNER') && startsWith(github.event.comment.body, '/style') }} 49 | name: style 50 | runs-on: ubuntu-latest 51 | env: 52 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 53 | steps: 54 | - uses: actions/checkout@v4 55 | 56 | - uses: r-lib/actions/pr-fetch@v2 57 | with: 58 | repo-token: ${{ secrets.GITHUB_TOKEN }} 59 | 60 | - uses: r-lib/actions/setup-r@v2 61 | 62 | - name: Install dependencies 63 | run: install.packages("styler") 64 | shell: Rscript {0} 65 | 66 | - name: Style 67 | run: styler::style_pkg() 68 | shell: Rscript {0} 69 | 70 | - name: commit 71 | run: | 72 | git config --local user.name "$GITHUB_ACTOR" 73 | git config --local user.email "$GITHUB_ACTOR@users.noreply.github.com" 74 | git add \*.R 75 | git commit -m 'Style' 76 | 77 | - uses: r-lib/actions/pr-push@v2 78 | with: 79 | repo-token: ${{ secrets.GITHUB_TOKEN }} 80 | -------------------------------------------------------------------------------- /vignettes/cloud.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "cloud" 3 | output: rmarkdown::html_vignette 4 | vignette: > 5 | %\VignetteIndexEntry{cloud} 6 | %\VignetteEngine{knitr::rmarkdown} 7 | %\VignetteEncoding{UTF-8} 8 | --- 9 | 10 | ```{r, include = FALSE} 11 | knitr::opts_chunk$set( 12 | collapse = TRUE, 13 | comment = "#>" 14 | ) 15 | ``` 16 | 17 | ```{r setup} 18 | library(revdepcheck) 19 | ``` 20 | 21 | # Running reverse dependencies in the cloud 22 | 23 | revdepcheck now supports running reverse dependencies in the AWS cloud, via a suite a functions all prefixed with `cloud_*()`. 24 | This service is currently only available to be used by RStudio employees, but we hope to offer this service for the broader R community in the future. 25 | 26 | ## Setup 27 | 28 | Set the `RSTUDIO_CLOUD_REVDEP_KEY` environment variable to the value of your cloud authentication key, provided to you by RStudio DevOps. 29 | Add this key to your `.Renviron` file with `usethis::edit_r_environ()` and restart R. 30 | 31 | ## Usage 32 | 33 | **Note** If you are going to be running 500+ tests and are using a development dependency (e.g. `Remote: org/pkg`) you may exhaust the GitHub API limits. A workaround is to use a 'url' remote, e.g. `Remote: url::https://github.com/org/pkg/archive/main.tar.gz`, which does not use the GitHub API. 34 | 35 | ```r 36 | # Kickoff a new check 37 | # The devel package is automatically built from the current 38 | # working directory, or specify a pre-built package with `tarball`. 39 | cloud_check() 40 | 41 | # Follow current status of the job 42 | cloud_status() 43 | 44 | # Cancel a job 45 | cloud_cancel() 46 | 47 | # Retrieve results (if needed) and show a summary 48 | cloud_summary() 49 | 50 | # Retrieve results (if needed) and generate a markdown report 51 | cloud_report() 52 | 53 | # Retrieve details of a specfic package 54 | cloud_details(, "pkgXYZ") 55 | 56 | # Plot running time for each package in a job 57 | cloud_plot() 58 | 59 | # Email maintainers with failures 60 | cloud_email() 61 | 62 | # Retrieve packages that broke in a given job 63 | cloud_broken() 64 | 65 | # Open a web browser to the AWS job pane for the current job 66 | cloud_browse() 67 | 68 | # Open the browser to the AWS job for a particular package 69 | # Useful for debugging why a particular job failed 70 | cloud_browse(package = "xyz") 71 | ``` 72 | 73 | The functions all keep track of the most recently submitted `job_id`, so assuming you only have one job in a given R session you can call the functions without additional parameters. 74 | Provide the `job_id` explicitly otherwise, results write to `revdep/{job_id}`. 75 | 76 | The `cloud_*()` functions assume your current working directory is in the root directory of the package you are trying to run reverse dependencies for. 77 | If this is not the case all `cloud_*()` functions take a `pkg` parameter, so you can specify a different directory if needed. 78 | -------------------------------------------------------------------------------- /R/utils.R: -------------------------------------------------------------------------------- 1 | #' @import rlang 2 | 3 | `%|0|%` <- function(x, y) { 4 | if (!length(x)) y else x 5 | } 6 | 7 | #' @importFrom utils installed.packages 8 | base_packages <- function() { 9 | rownames(installed.packages(priority = "base")) 10 | } 11 | 12 | lapply_with_names <- function(X, FUN, ...) { 13 | n <- if (!is.null(names(X))) { 14 | names(X) 15 | } else if (is.character(X)) { 16 | X 17 | } 18 | structure(map(X, FUN, ...), names = n) 19 | } 20 | 21 | drop_nulls <- function(x) { 22 | is_null <- map_lgl(x, is.null) 23 | x[!is_null] 24 | } 25 | 26 | #' @importFrom crayon col_nchar 27 | 28 | col_align <- function( 29 | text, 30 | width = getOption("width"), 31 | align = c("left", "center", "right") 32 | ) { 33 | align <- match.arg(align) 34 | nc <- col_nchar(text) 35 | 36 | if (width <= nc) { 37 | text 38 | } else if (align == "left") { 39 | paste0(text, make_space(width - nc)) 40 | } else if (align == "center") { 41 | paste0( 42 | make_space(ceiling((width - nc) / 2)), 43 | text, 44 | make_space(floor((width - nc) / 2)) 45 | ) 46 | } else { 47 | paste0(make_space(width - nc), text) 48 | } 49 | } 50 | 51 | make_space <- function(num, filling = " ") { 52 | strrep(filling, num) 53 | } 54 | 55 | compact <- function(x) Filter(Negate(is.null), x) 56 | 57 | clear_line <- function(width = getOption("width")) { 58 | spaces <- paste(rep(" ", width), collapse = "") 59 | cat("\r", spaces, "\r", sep = "") 60 | } 61 | 62 | str_trunc <- function(x, n) { 63 | if (n <= 3) { 64 | substr("...", 1, n) 65 | } else if (nchar(x) < n) { 66 | x 67 | } else { 68 | paste0(substr(x, 1, n - 3), "...") 69 | } 70 | } 71 | 72 | line_trunc <- function(x, n = 10) { 73 | if (length(x) == 1 && grepl("\n", x, fixed = TRUE)) { 74 | x <- strsplit(x, "\n")[[1]] 75 | } 76 | 77 | if (length(x) < n * 2) { 78 | return(x) 79 | } 80 | 81 | c(x[1:n], "...", x[(length(x) - n + 1):length(x)]) 82 | } 83 | 84 | #' @importFrom withr with_libpaths with_envvar 85 | 86 | execute_r <- function(px_opts, new_session = FALSE) { 87 | if (new_session) { 88 | do.call(r, px_opts) 89 | } else { 90 | rlang::with_options( 91 | repos = px_opts$repos, 92 | with_libpaths( 93 | px_opts$libpath, 94 | with_envvar(px_opts$env, do.call(px_opts$func, px_opts$args)) 95 | ) 96 | ) 97 | } 98 | } 99 | 100 | str_trim <- function(x) { 101 | sub("\\s+$", "", sub("^\\s+", "", x)) 102 | } 103 | 104 | cut_into_lines <- function(x) { 105 | x <- do.call(paste0, as.list(x)) 106 | x <- gsub("\r\n", "\n", x, fixed = TRUE) 107 | x <- strsplit(x, "\n", fixed = TRUE)[[1]] 108 | if (length(x)) x else "" 109 | } 110 | 111 | latest_file <- function(x) { 112 | mtime <- file.info(x)$mtime 113 | tail(x[order(mtime)], 1) 114 | } 115 | -------------------------------------------------------------------------------- /R/deps.R: -------------------------------------------------------------------------------- 1 | #' Retrieve the reverse dependencies for a package 2 | #' 3 | #' @param package The package (or packages) to search for reverse dependencies. 4 | #' @inheritParams revdep_check 5 | #' @export 6 | cran_revdeps <- function( 7 | package, 8 | dependencies = TRUE, 9 | bioc = FALSE, 10 | cran = TRUE 11 | ) { 12 | pkgs <- lapply(package, function(pkg) { 13 | cran_revdeps_versions(pkg, dependencies, bioc, cran)$package 14 | }) 15 | pkgs <- unique(unlist(pkgs)) 16 | pkgs[order(tolower(pkgs))] 17 | } 18 | 19 | #' @importFrom remotes bioc_install_repos 20 | #' @importFrom crancache available_packages 21 | 22 | cran_revdeps_versions <- function( 23 | package, 24 | dependencies = TRUE, 25 | bioc = FALSE, 26 | cran = TRUE 27 | ) { 28 | stopifnot(is_string(package)) 29 | repos <- get_repos(bioc, cran) 30 | 31 | allpkgs <- available_packages(repos = repos) 32 | alldeps <- allpkgs[, dependencies, drop = FALSE] 33 | alldeps[is.na(alldeps)] <- "" 34 | deps <- apply(alldeps, 1, paste, collapse = ",") 35 | rd <- grepl(sprintf("(,| |\\n)(%s)(,| |\\n)", package), deps) 36 | 37 | data.frame( 38 | stringsAsFactors = FALSE, 39 | package = unname(allpkgs[rd, "Package"]), 40 | version = unname(allpkgs[rd, "Version"]) 41 | ) 42 | } 43 | 44 | get_repos <- function(bioc, cran) { 45 | repos <- c( 46 | getOption("repos"), 47 | if (bioc) bioc_install_repos() 48 | ) 49 | 50 | if ((!"CRAN" %in% names(repos) || repos["CRAN"] == "@CRAN@") && cran) { 51 | repos["CRAN"] <- "https://cloud.r-project.org" 52 | } 53 | 54 | ## Drop duplicated repos (by name only) 55 | ## If the repos is not a named vector, names would be a NULL 56 | ## and duplicated(names) would be a logical(0) resulting in dropping entire 57 | ## vector 58 | names <- names(repos) %|0|% rep("", times = length(repos)) 59 | repos <- repos[!(nzchar(names) & duplicated(names))] 60 | 61 | repos 62 | } 63 | 64 | cran_deps <- function(package, repos) { 65 | allpkgs <- available_packages(repos = repos) 66 | current <- deps <- package 67 | dependencies <- c("Depends", "Imports", "LinkingTo", "Suggests") 68 | while (TRUE) { 69 | deprecs <- allpkgs[allpkgs[, "Package"] %in% deps, dependencies] 70 | newdeps <- unlist(parse_deps(deprecs)) 71 | deps <- unique(sort(c(deps, newdeps))) 72 | if (identical(current, deps)) { 73 | break 74 | } 75 | dependencies <- c("Depends", "Imports", "LinkingTo") 76 | current <- deps 77 | } 78 | 79 | setdiff(deps, c(package, base_packages())) 80 | } 81 | 82 | parse_deps <- function(deps) { 83 | deps[is.na(deps)] <- "" 84 | deps <- gsub("\\s+", "", deps) 85 | deps <- gsub("\\([^)]+\\)", "", deps) 86 | notempty <- nzchar(deps) 87 | res <- replicate(length(deps), character()) 88 | deps <- deps[notempty] 89 | deps <- strsplit(deps, ",", fixed = TRUE) 90 | 91 | base <- base_packages() 92 | deps <- map(deps, setdiff, y = c("R", base)) 93 | 94 | res[notempty] <- deps 95 | res 96 | } 97 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ## Features 2 | 3 | * To avoid false positives due to existing failures, revdepcheck runs 4 | `R CMD check` twice for each revdep, once with the CRAN version of your 5 | package, and once with the local development version. revdepcheck 6 | reports the difference, so you can see exactly what has changed. 7 | 8 | * To speed up installation of revdeps and their dependencies, revdepcheck 9 | relies on [crancache](https://github.com/r-lib/crancache). You can see what 10 | packages are currently cached with `crancache::crancache_list()`. 11 | 12 | * revdepcheck is carefully designed to make long running checks as pleasant 13 | as possible. You run checks in parallel, check time is limited to 10 minutes, 14 | and an elegant progress bar keeps you up-to-date with what's happening 15 | (including an estimate of how much time is remaining). 16 | 17 | ## Installation 18 | 19 | ```r 20 | pak::pkg_install("r-lib/revdepcheck") 21 | ``` 22 | 23 | ## Usage 24 | 25 | ```r 26 | library(revdepcheck) 27 | ``` 28 | 29 | Check package in working directory, creating "revdep/" directory if it doesn't already exist: 30 | ```r 31 | revdep_check(num_workers = 4) 32 | ``` 33 | If the run fails to complete, run again and it will pick up where it left off: 34 | ```r 35 | revdep_check(num_workers = 4) 36 | ``` 37 | 38 | During execution, run these in a *separate R process* to view status completed checks: 39 | ```r 40 | revdep_summary() # table of results by package 41 | revdep_details(".", "") # full details for the specified package 42 | ``` 43 | Generate human-friendly summary documents in `revdep/`: 44 | ```r 45 | revdep_report() 46 | ## Writing *partial* report 47 | ## Writing summary to 'revdep/README.md' 48 | ## Writing problems to 'revdep/problems.md' 49 | ## Writing failures to 'revdep/failures.md' 50 | ``` 51 | 52 | Manage a "todo" list of packages to examine: 53 | ```r 54 | revdep_add(pkg = ".", ) # add to the list 55 | revdep_rm(pkg = ".", ). # remove from list 56 | 57 | revdep_add_broken() # add all broken packages 58 | revdep_add_new() # add newly available packages 59 | revdep_todo() # list packages in the todo list 60 | ``` 61 | 62 | Clear out all previous results 63 | ```r 64 | revdep_reset() 65 | ``` 66 | 67 | We recommend running `revdep_check()` in a separate process (e.g. new terminal under RStudio). That way, while it runs in a background tab, you can easily use your `revdep_details(revdep = "pkg")` to see what's gone wrong with "pkg". 68 | 69 | ## Status Flags: 70 | 71 | * install newly fails: `i-` 72 | * install still fails: `i+` 73 | * install/check newly timeouts: `t-` 74 | * install/check still timeouts: `t+` 75 | * No new failures, success: `+` 76 | * Some new failures: `-` 77 | 78 | 79 | ## License 80 | 81 | MIT © 82 | [Gábor Csárdi](https://github.com/gaborcsardi), 83 | [R Consortium](https://github.com/rconsortium), 84 | [RStudio Inc](https://github.com/rstudio) 85 | -------------------------------------------------------------------------------- /man/revdep_check.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/revdepcheck.R 3 | \name{revdep_check} 4 | \alias{revdep_check} 5 | \alias{revdep_reset} 6 | \title{Run revdep checks} 7 | \usage{ 8 | revdep_check( 9 | pkg = ".", 10 | dependencies = c("Depends", "Imports", "Suggests", "LinkingTo"), 11 | quiet = TRUE, 12 | timeout = as.difftime(10, units = "mins"), 13 | num_workers = 1, 14 | bioc = TRUE, 15 | cran = TRUE, 16 | env = revdep_env_vars() 17 | ) 18 | 19 | revdep_reset(pkg = ".") 20 | } 21 | \arguments{ 22 | \item{pkg}{Path to package.} 23 | 24 | \item{dependencies}{Which types of revdeps should be checked. For CRAN 25 | release, we recommend using the default.} 26 | 27 | \item{quiet}{Suppress output from internal processes?} 28 | 29 | \item{timeout}{Maximum time to wait (in seconds) for \verb{R CMD check} to 30 | complete. Default is 10 minutes.} 31 | 32 | \item{num_workers}{Number of parallel workers to use} 33 | 34 | \item{bioc}{Also check revdeps that live in Bioconductor?} 35 | 36 | \item{cran}{Should cran mirror be attached to getOpion("repos") if it 37 | is not already present.} 38 | 39 | \item{env}{Environment variables to set for the install and check 40 | processes. See \code{\link[=revdep_env_vars]{revdep_env_vars()}}.} 41 | } 42 | \description{ 43 | \code{revdep_check()} runs \verb{R CMD check} on all reverse dependencies of your 44 | package. To avoid false positives, it runs \verb{R CMD check} twice: once for 45 | released version on CRAN and once for the local development version. It 46 | then reports the differences so you can see what checks were previously 47 | ok but now fail. 48 | 49 | It requires to use a repos option that provides the source code of the packages not binaries. 50 | 51 | Once your package has been successfully submitted to CRAN, you should 52 | run \code{revdep_reset()}. This deletes all files used for checking, freeing 53 | up disk space and leaving you in a clean state for the next release. 54 | } 55 | \details{ 56 | \code{revdep_check()} proceeds in four steps: 57 | \enumerate{ 58 | \item \strong{Init}: create the \verb{revdep/} subdirectory if it doesn't already exist, 59 | and save the list of reverse dependencies to check. 60 | \item \strong{Install}: install the CRAN (released) and local (development) 61 | versions of your package, including all dependencies. 62 | \item \strong{Run}: run \verb{R CMD check} twice for each reverse dependency, once 63 | for the CRAN version and one for the local version. The checks are 64 | run in parallel using \code{num_worker} processes. 65 | \item \strong{Report}: generate reports showing differences between the check 66 | results for the CRAN and local versions of your package. The focus of 67 | the report is on new failures. The reports are saved in \verb{revdep/}. 68 | } 69 | 70 | \code{revdep_check()} is designed to seamlessly resume in the case of failure: 71 | just re-run \code{revdep_check()} and it will start from where it left off. 72 | If you want to start again from scratch, run \code{revdep_reset()}. 73 | } 74 | \seealso{ 75 | To see more details of problems during a run, call 76 | \code{\link[=revdep_summary]{revdep_summary()}} and \code{\link[=revdep_details]{revdep_details()}} in another process. 77 | } 78 | -------------------------------------------------------------------------------- /R/dirs.R: -------------------------------------------------------------------------------- 1 | #' Set up/retrieve the directory structure for the checks 2 | #' 3 | #' Currently the following files and directories are used. 4 | #' They are all in the main revdep directory, which is `revdep` in the 5 | #' package tree. 6 | #' * `library`: a collection of package libraries 7 | #' * `library/data.sqlite`: the SQLite database that contains the check 8 | #' data. 9 | #' * `library//old`: library that contains the *old* version 10 | #' of the revdep-checked package, together with its dependencies. 11 | #' * `library//new`: library that contains the *new* version 12 | #' of the revdep-checked package, together with its dependencies. 13 | #' * `library/` are the libraries for the reverse dependencies. 14 | #' 15 | #' @param pkgdir Path to the package we are revdep-checking. 16 | #' @param what Directory to query: 17 | #' * `"root"`: the root of the check directory, 18 | #' * `"db"`: the database file, 19 | #' * `"old"`: the library of the old version of the package. 20 | #' * `"new"`: the library of the new version of the package. 21 | #' * `"pkg"`: the library of the reverse dependency, the `package` 22 | #' argument must be supplied as well. 23 | #' * `"check"`: the check directory of the reverse dependency, the 24 | #' `package` argument must be supplied as well. 25 | #' * `"pkgold"`: package libraries to use when checking `package` with 26 | #' the old version. 27 | #' * `"pkgnew"`: package libraries to use when checking `package` with 28 | #' the new version. 29 | #' @param package The name of the package, if `what` is `"pkg"`, `"check"`, 30 | #' `"pkgold"` or `"pkgnew"`. 31 | #' @return Character scalar, the requested path. 32 | #' 33 | #' @keywords internal 34 | 35 | dir_find <- function( 36 | pkgdir, 37 | what = c( 38 | "root", 39 | "db", 40 | "old", 41 | "new", 42 | "pkg", 43 | "check", 44 | "checks", 45 | "lib", 46 | "pkgold", 47 | "pkgnew", 48 | "cloud" 49 | ), 50 | package = NULL 51 | ) { 52 | pkgdir <- pkg_check(pkgdir) 53 | pkg <- pkg_name(pkgdir) 54 | 55 | idx <- if (Sys.info()[["sysname"]] == "Darwin") { 56 | function(x) paste0(x, ".noindex") 57 | } else { 58 | function(x) x 59 | } 60 | 61 | switch( 62 | match.arg(what), 63 | root = file.path(pkgdir, "revdep"), 64 | db = file.path(pkgdir, "revdep", "data.sqlite"), 65 | 66 | checks = file.path(pkgdir, "revdep", idx("checks")), 67 | check = file.path(pkgdir, "revdep", idx("checks"), package), 68 | 69 | lib = file.path(pkgdir, "revdep", idx("library")), 70 | pkg = file.path(pkgdir, "revdep", idx("library"), package), 71 | old = file.path(pkgdir, "revdep", idx("library"), pkg, "old"), 72 | new = file.path(pkgdir, "revdep", idx("library"), pkg, "new"), 73 | 74 | ## Order is important here, because installs should go to the first 75 | pkgold = c( 76 | file.path(pkgdir, "revdep", idx("library"), package), 77 | file.path(pkgdir, "revdep", idx("library"), pkg, "old") 78 | ), 79 | pkgnew = c( 80 | file.path(pkgdir, "revdep", idx("library"), package), 81 | file.path(pkgdir, "revdep", idx("library"), pkg, "new") 82 | ), 83 | cloud = c(file.path(pkgdir, "revdep", idx("cloud"))) 84 | ) 85 | } 86 | 87 | #' @export 88 | #' @rdname dir_find 89 | 90 | dir_setup <- function(pkgdir) { 91 | dir_create(dir_find(pkgdir, "root")) 92 | dir_create(dir_find(pkgdir, "checks")) 93 | } 94 | 95 | #' @export 96 | #' @rdname dir_find 97 | 98 | dir_setup_package <- function(pkgdir, package) { 99 | dir_create(dir_find(pkgdir, "pkgold", package)) 100 | dir_create(dir_find(pkgdir, "pkgnew", package)) 101 | dir_create(dir_find(pkgdir, "check", package)) 102 | } 103 | 104 | dir_create <- function(paths) { 105 | map_lgl(paths, dir.create, recursive = TRUE, showWarnings = FALSE) 106 | } 107 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method(print,rcmdcheck_error_summary) 4 | S3method(print,revdepcheck_details) 5 | S3method(print,revdepcheck_maintainers) 6 | S3method(print,revdepcheck_results) 7 | S3method(rcmdcheck_status,rcmdcheck_comparison) 8 | S3method(rcmdcheck_status,rcmdcheck_error) 9 | S3method(rcmdcheck_version,rcmdcheck_comparison) 10 | S3method(rcmdcheck_version,rcmdcheck_error) 11 | S3method(summary,rcmdcheck_error) 12 | export(cloud_broken) 13 | export(cloud_browse) 14 | export(cloud_cancel) 15 | export(cloud_check) 16 | export(cloud_details) 17 | export(cloud_email) 18 | export(cloud_failed) 19 | export(cloud_fetch_results) 20 | export(cloud_job) 21 | export(cloud_job_mapping) 22 | export(cloud_plot) 23 | export(cloud_report) 24 | export(cloud_report_checklist) 25 | export(cloud_report_cran) 26 | export(cloud_report_failures) 27 | export(cloud_report_problems) 28 | export(cloud_report_summary) 29 | export(cloud_results) 30 | export(cloud_status) 31 | export(cloud_summary) 32 | export(cran_revdeps) 33 | export(dir_setup) 34 | export(dir_setup_package) 35 | export(revdep_add) 36 | export(revdep_add_broken) 37 | export(revdep_add_new) 38 | export(revdep_check) 39 | export(revdep_details) 40 | export(revdep_email) 41 | export(revdep_email_draft) 42 | export(revdep_env_vars) 43 | export(revdep_maintainers) 44 | export(revdep_report) 45 | export(revdep_report_cran) 46 | export(revdep_report_failures) 47 | export(revdep_report_problems) 48 | export(revdep_report_summary) 49 | export(revdep_reset) 50 | export(revdep_rm) 51 | export(revdep_summary) 52 | export(revdep_todo) 53 | import(rlang) 54 | importFrom(DBI,dbExecute) 55 | importFrom(DBI,dbGetQuery) 56 | importFrom(DBI,dbReadTable) 57 | importFrom(DBI,dbWithTransaction) 58 | importFrom(DBI,dbWriteTable) 59 | importFrom(DBI,sqlInterpolate) 60 | importFrom(RSQLite,SQLite) 61 | importFrom(RSQLite,dbConnect) 62 | importFrom(RSQLite,dbExistsTable) 63 | importFrom(RSQLite,dbIsValid) 64 | importFrom(assertthat,"on_failure<-") 65 | importFrom(assertthat,assert_that) 66 | importFrom(callr,r) 67 | importFrom(callr,r_process) 68 | importFrom(callr,r_process_options) 69 | importFrom(cli,cli_alert) 70 | importFrom(cli,cli_alert_danger) 71 | importFrom(cli,cli_alert_info) 72 | importFrom(cli,cli_alert_success) 73 | importFrom(cli,cli_format) 74 | importFrom(cli,cli_progress_bar) 75 | importFrom(cli,cli_progress_done) 76 | importFrom(cli,cli_progress_update) 77 | importFrom(cli,cli_status) 78 | importFrom(cli,cli_status_clear) 79 | importFrom(cli,cli_status_update) 80 | importFrom(cli,col_blue) 81 | importFrom(cli,col_green) 82 | importFrom(cli,col_red) 83 | importFrom(cli,pb_percent) 84 | importFrom(cli,rule) 85 | importFrom(cli,style_bold) 86 | importFrom(clisymbols,symbol) 87 | importFrom(crancache,available_packages) 88 | importFrom(crancache,install_packages) 89 | importFrom(crayon,bgRed) 90 | importFrom(crayon,black) 91 | importFrom(crayon,bold) 92 | importFrom(crayon,col_nchar) 93 | importFrom(crayon,cyan) 94 | importFrom(crayon,green) 95 | importFrom(crayon,make_style) 96 | importFrom(crayon,red) 97 | importFrom(crayon,white) 98 | importFrom(crayon,yellow) 99 | importFrom(curl,handle_setheaders) 100 | importFrom(curl,handle_setopt) 101 | importFrom(curl,multi_add) 102 | importFrom(curl,multi_run) 103 | importFrom(curl,new_handle) 104 | importFrom(curl,new_pool) 105 | importFrom(glue,glue_data) 106 | importFrom(gmailr,mime) 107 | importFrom(gmailr,send_message) 108 | importFrom(httr,GET) 109 | importFrom(httr,PATCH) 110 | importFrom(httr,POST) 111 | importFrom(httr,add_headers) 112 | importFrom(httr,content) 113 | importFrom(httr,headers) 114 | importFrom(httr,http_status) 115 | importFrom(httr,status_code) 116 | importFrom(httr,stop_for_status) 117 | importFrom(knitr,kable) 118 | importFrom(prettyunits,vague_dt) 119 | importFrom(processx,process) 120 | importFrom(progress,progress_bar) 121 | importFrom(rcmdcheck,check_details) 122 | importFrom(rcmdcheck,compare_checks) 123 | importFrom(rcmdcheck,rcmdcheck_process) 124 | importFrom(remotes,bioc_install_repos) 125 | importFrom(remotes,install_local) 126 | importFrom(sessioninfo,platform_info) 127 | importFrom(utils,available.packages) 128 | importFrom(utils,installed.packages) 129 | importFrom(utils,tail) 130 | importFrom(whoami,fullname) 131 | importFrom(withr,with_envvar) 132 | importFrom(withr,with_libpaths) 133 | importFrom(yaml,as.yaml) 134 | importFrom(yaml,yaml.load_file) 135 | -------------------------------------------------------------------------------- /R/compat-purrr.R: -------------------------------------------------------------------------------- 1 | # nocov start - compat-purrr (last updated: rlang 0.3.0) 2 | 3 | # This file serves as a reference for compatibility functions for 4 | # purrr. They are not drop-in replacements but allow a similar style 5 | # of programming. This is useful in cases where purrr is too heavy a 6 | # package to depend on. Please find the most recent version in rlang's 7 | # repository. 8 | 9 | map <- function(.x, .f, ...) { 10 | lapply(.x, .f, ...) 11 | } 12 | map_mold <- function(.x, .f, .mold, ...) { 13 | out <- vapply(.x, .f, .mold, ..., USE.NAMES = FALSE) 14 | names(out) <- names(.x) 15 | out 16 | } 17 | map_lgl <- function(.x, .f, ...) { 18 | map_mold(.x, .f, logical(1), ...) 19 | } 20 | map_int <- function(.x, .f, ...) { 21 | map_mold(.x, .f, integer(1), ...) 22 | } 23 | map_dbl <- function(.x, .f, ...) { 24 | map_mold(.x, .f, double(1), ...) 25 | } 26 | map_chr <- function(.x, .f, ...) { 27 | map_mold(.x, .f, character(1), ...) 28 | } 29 | map_cpl <- function(.x, .f, ...) { 30 | map_mold(.x, .f, complex(1), ...) 31 | } 32 | 33 | pluck <- function(.x, .f) { 34 | map(.x, `[[`, .f) 35 | } 36 | pluck_lgl <- function(.x, .f) { 37 | map_lgl(.x, `[[`, .f) 38 | } 39 | pluck_int <- function(.x, .f) { 40 | map_int(.x, `[[`, .f) 41 | } 42 | pluck_dbl <- function(.x, .f) { 43 | map_dbl(.x, `[[`, .f) 44 | } 45 | pluck_chr <- function(.x, .f) { 46 | map_chr(.x, `[[`, .f) 47 | } 48 | pluck_cpl <- function(.x, .f) { 49 | map_cpl(.x, `[[`, .f) 50 | } 51 | 52 | map2 <- function(.x, .y, .f, ...) { 53 | out <- mapply(.f, .x, .y, MoreArgs = list(...), SIMPLIFY = FALSE) 54 | if (length(out) == length(.x)) { 55 | set_names(out, names(.x)) 56 | } else { 57 | set_names(out, NULL) 58 | } 59 | } 60 | map2_lgl <- function(.x, .y, .f, ...) { 61 | as.vector(map2(.x, .y, .f, ...), "logical") 62 | } 63 | map2_int <- function(.x, .y, .f, ...) { 64 | as.vector(map2(.x, .y, .f, ...), "integer") 65 | } 66 | map2_dbl <- function(.x, .y, .f, ...) { 67 | as.vector(map2(.x, .y, .f, ...), "double") 68 | } 69 | map2_chr <- function(.x, .y, .f, ...) { 70 | as.vector(map2(.x, .y, .f, ...), "character") 71 | } 72 | map2_cpl <- function(.x, .y, .f, ...) { 73 | as.vector(map2(.x, .y, .f, ...), "complex") 74 | } 75 | 76 | args_recycle <- function(args) { 77 | lengths <- map_int(args, length) 78 | n <- max(lengths) 79 | 80 | stopifnot(all(lengths == 1L | lengths == n)) 81 | to_recycle <- lengths == 1L 82 | args[to_recycle] <- map(args[to_recycle], function(x) rep.int(x, n)) 83 | 84 | args 85 | } 86 | pmap <- function(.l, .f, ...) { 87 | args <- args_recycle(.l) 88 | do.call( 89 | "mapply", 90 | c( 91 | FUN = list(quote(.f)), 92 | args, 93 | MoreArgs = quote(list(...)), 94 | SIMPLIFY = FALSE, 95 | USE.NAMES = FALSE 96 | ) 97 | ) 98 | } 99 | 100 | probe <- function(.x, .p, ...) { 101 | if (is_logical(.p)) { 102 | stopifnot(length(.p) == length(.x)) 103 | .p 104 | } else { 105 | map_lgl(.x, .p, ...) 106 | } 107 | } 108 | 109 | keep <- function(.x, .f, ...) { 110 | .x[probe(.x, .f, ...)] 111 | } 112 | discard <- function(.x, .p, ...) { 113 | sel <- probe(.x, .p, ...) 114 | .x[is.na(sel) | !sel] 115 | } 116 | map_if <- function(.x, .p, .f, ...) { 117 | matches <- probe(.x, .p) 118 | .x[matches] <- map(.x[matches], .f, ...) 119 | .x 120 | } 121 | 122 | compact <- function(.x) { 123 | Filter(length, .x) 124 | } 125 | 126 | transpose <- function(.l) { 127 | inner_names <- names(.l[[1]]) 128 | if (is.null(inner_names)) { 129 | fields <- seq_along(.l[[1]]) 130 | } else { 131 | fields <- set_names(inner_names) 132 | } 133 | 134 | map(fields, function(i) { 135 | map(.l, .subset2, i) 136 | }) 137 | } 138 | 139 | every <- function(.x, .p, ...) { 140 | for (i in seq_along(.x)) { 141 | if (!rlang::is_true(.p(.x[[i]], ...))) return(FALSE) 142 | } 143 | TRUE 144 | } 145 | some <- function(.x, .p, ...) { 146 | for (i in seq_along(.x)) { 147 | if (rlang::is_true(.p(.x[[i]], ...))) return(TRUE) 148 | } 149 | FALSE 150 | } 151 | negate <- function(.p) { 152 | function(...) !.p(...) 153 | } 154 | 155 | reduce <- function(.x, .f, ..., .init) { 156 | f <- function(x, y) .f(x, y, ...) 157 | Reduce(f, .x, init = .init) 158 | } 159 | reduce_right <- function(.x, .f, ..., .init) { 160 | f <- function(x, y) .f(y, x, ...) 161 | Reduce(f, .x, init = .init, right = TRUE) 162 | } 163 | accumulate <- function(.x, .f, ..., .init) { 164 | f <- function(x, y) .f(x, y, ...) 165 | Reduce(f, .x, init = .init, accumulate = TRUE) 166 | } 167 | accumulate_right <- function(.x, .f, ..., .init) { 168 | f <- function(x, y) .f(y, x, ...) 169 | Reduce(f, .x, init = .init, right = TRUE, accumulate = TRUE) 170 | } 171 | 172 | detect <- function(.x, .f, ..., .right = FALSE, .p = is_true) { 173 | for (i in index(.x, .right)) { 174 | if (.p(.f(.x[[i]], ...))) { 175 | return(.x[[i]]) 176 | } 177 | } 178 | NULL 179 | } 180 | detect_index <- function(.x, .f, ..., .right = FALSE, .p = is_true) { 181 | for (i in index(.x, .right)) { 182 | if (.p(.f(.x[[i]], ...))) { 183 | return(i) 184 | } 185 | } 186 | 0L 187 | } 188 | index <- function(x, right = FALSE) { 189 | idx <- seq_along(x) 190 | if (right) { 191 | idx <- rev(idx) 192 | } 193 | idx 194 | } 195 | 196 | # nocov end 197 | -------------------------------------------------------------------------------- /R/deps-install.R: -------------------------------------------------------------------------------- 1 | #' @importFrom processx process 2 | #' @importFrom callr r r_process r_process_options 3 | #' @importFrom crancache available_packages 4 | #' @importFrom withr with_envvar 5 | 6 | deps_install_opts <- function( 7 | pkgdir, 8 | pkgname, 9 | quiet = FALSE, 10 | env = character() 11 | ) { 12 | func <- function(libdir, packages, quiet, repos) { 13 | ip <- crancache::install_packages 14 | withr::with_libpaths( 15 | libdir, 16 | { 17 | ip( 18 | packages, 19 | dependencies = FALSE, 20 | lib = libdir[1], 21 | quiet = quiet, 22 | repos = repos 23 | ) 24 | stopifnot(all(packages %in% rownames(installed.packages(libdir[1])))) 25 | } 26 | ) 27 | } 28 | 29 | args <- c( 30 | ## We don't want to install the revdep checked package again, 31 | ## that's in a separate library, hence the `exclude` argument 32 | deps_opts(pkgname, exclude = pkg_name(pkgdir)), 33 | 34 | list( 35 | libdir = dir_find(pkgdir, "pkg", pkgname), 36 | quiet = quiet 37 | ) 38 | ) 39 | 40 | ## CRANCACHE_REPOS makes sure that we only use cached CRAN packages, 41 | ## but not packages that were installed from elsewhere 42 | r_process_options( 43 | func = func, 44 | args = args, 45 | system_profile = FALSE, 46 | user_profile = FALSE, 47 | env = c( 48 | CRANCACHE_REPOS = "cran,bioc", 49 | CRANCACHE_QUIET = if (quiet) "yes" else "no", 50 | env 51 | ) 52 | ) 53 | } 54 | 55 | deps_opts <- function(pkgname, exclude = character()) { 56 | ## We set repos, so that dependencies from Bioconductor are installed 57 | ## automatically 58 | repos <- get_repos(bioc = TRUE, cran = TRUE) 59 | 60 | ## We have to do this "manually", because some of the dependencies 61 | ## might be also dependencies of crancache, so they will be already 62 | ## installed in another library directory, and also loaded. 63 | ## But we want to install everything into the package's specific library, 64 | ## because this is the only library used for the check. 65 | '!DEBUG Querying dependencies of `paste(pkgname, collapse = ", ")`' 66 | packages <- cran_deps(pkgname, repos) 67 | 68 | packages <- setdiff(packages, exclude) 69 | 70 | ## We do this, because if a package is not available, 71 | ## utils::install.packages does not install anything, just gives a 72 | ## warning 73 | "!DEBUG dropping unavailable dependencies" 74 | available <- with_envvar( 75 | c(CRANCACHE_REPOS = "cran,bioc", CRANCACHE_QUIET = "yes"), 76 | rownames(available_packages(repos = repos)) 77 | ) 78 | packages <- intersect(packages, available) 79 | 80 | list( 81 | package = packages, 82 | repos = repos 83 | ) 84 | } 85 | 86 | deps_install_task <- function(state, task) { 87 | pkgdir <- state$options$pkgdir 88 | pkgname <- task$args[[1]] 89 | 90 | dir_setup_package(pkgdir, pkgname) 91 | 92 | "!DEBUG Install dependencies for package `pkgname`" 93 | px_opts <- deps_install_opts( 94 | pkgdir, 95 | pkgname, 96 | quiet = state$options$quiet, 97 | env = state$options$env 98 | ) 99 | px <- r_process$new(px_opts) 100 | 101 | ## Update state 102 | worker <- list( 103 | process = px, 104 | package = pkgname, 105 | stdout = character(), 106 | stderr = character(), 107 | task = task 108 | ) 109 | state$workers <- c(state$workers, list(worker)) 110 | 111 | wpkg <- match(worker$package, state$packages$package) 112 | state$packages$state[wpkg] <- "deps_installing" 113 | 114 | state 115 | } 116 | 117 | deps_install_done <- function(state, worker) { 118 | starttime <- worker$process$get_start_time() 119 | duration <- as.numeric(Sys.time() - starttime) 120 | wpkg <- match(worker$package, state$packages$package) 121 | 122 | worker$process$wait(timeout = 1000) 123 | worker$process$kill() 124 | if (worker$process$get_exit_status()) { 125 | ## failed, we just stop the whole package 126 | cleanup_library(state, worker) 127 | state$packages$state[wpkg] <- "done" 128 | 129 | rresult <- if (isTRUE(worker$killed)) { 130 | "Process was killed while installing dependencies" 131 | status <- "TIMEOUT" 132 | } else { 133 | status <- "PREPERROR" 134 | tryCatch( 135 | worker$process$get_result(), 136 | error = function(e) conditionMessage(e) 137 | ) 138 | } 139 | 140 | result <- list( 141 | stdout = worker$stdout, 142 | stderr = worker$stderr, 143 | errormsg = rresult 144 | ) 145 | 146 | for (which in c("old", "new")) { 147 | db_insert( 148 | state$options$pkgdir, 149 | worker$package, 150 | version = NULL, 151 | status = status, 152 | which = which, 153 | duration = duration, 154 | starttime = starttime, 155 | result = unclass(toJSON(result)), 156 | summary = NULL 157 | ) 158 | } 159 | } else { 160 | ## succeeded 161 | state$packages$state[wpkg] <- "deps_installed" 162 | } 163 | 164 | state 165 | } 166 | 167 | # Not used by other methods, but simplifies debugging 168 | deps_install <- function(pkgdir, pkgname, quiet = FALSE, new_session = FALSE) { 169 | px_opts <- deps_install_opts(pkgdir, pkgname, quiet = FALSE) 170 | execute_r(px_opts, new_session = new_session) 171 | } 172 | -------------------------------------------------------------------------------- /R/check.R: -------------------------------------------------------------------------------- 1 | #' @importFrom rcmdcheck rcmdcheck_process 2 | 3 | check_proc <- function( 4 | pkgdir, 5 | pkgname, 6 | version = c("old", "new"), 7 | env = character() 8 | ) { 9 | version <- match.arg(version) 10 | 11 | dir <- dir_find(pkgdir, "check", pkgname) 12 | tarball <- latest_file(dir(dir, pattern = "\\.tar\\.gz$", full.names = TRUE)) 13 | if (length(tarball) == 0) { 14 | stop( 15 | sprintf( 16 | "Internal error for package %s. No *.tar.gz file found.", 17 | pkgname 18 | ), 19 | call. = FALSE 20 | ) 21 | } 22 | 23 | out <- file.path(dir, version) 24 | unlink(out, recursive = TRUE) 25 | dir.create(out, recursive = TRUE, showWarnings = FALSE) 26 | 27 | ## We reverse the library, because the new version of the revdep checked 28 | ## package might have custom non-CRAN dependencies, and we want these 29 | ## to be first on the library path 30 | lib <- rev(dir_find(pkgdir, paste0("pkg", version), pkgname)) 31 | library_info(file.path(out, "libraries.txt"), lib) 32 | 33 | with_envvar( 34 | c("R_ENVIRON_USER" = tempdir(), "R_LIBS" = "", "NO_COLOR" = "true", env), 35 | rcmdcheck_process$new( 36 | path = tarball, 37 | libpath = lib, 38 | args = c("--no-manual", "--no-build-vignettes", "-o", out) 39 | ) 40 | ) 41 | } 42 | 43 | check_task <- function(state, task) { 44 | pkgdir <- state$options$pkgdir 45 | pkgname <- task$args[[1]] 46 | version <- task$args[[2]] 47 | 48 | "!DEBUG Checking `pkgname`" 49 | px <- check_proc(pkgdir, pkgname, version = version, env = state$options$env) 50 | 51 | ## Update state 52 | worker <- list( 53 | process = px, 54 | package = pkgname, 55 | stdout = character(), 56 | stderr = character(), 57 | task = task 58 | ) 59 | state$workers <- c(state$workers, list(worker)) 60 | 61 | wpkg <- match(worker$package, state$packages$package) 62 | current_state <- state$packages$state[wpkg] 63 | 64 | new_state <- 65 | if (current_state == "downloaded" && version == "old") { 66 | "checking" 67 | } else if (current_state == "checking" && version == "new") { 68 | "checking-checking" 69 | } else if (current_state == "done-downloaded" && version == "new") { 70 | "done-checking" 71 | } else { 72 | stop("Internal revdepcheck error, invalid state") 73 | } 74 | state$packages$state[wpkg] <- new_state 75 | 76 | state 77 | } 78 | 79 | #' Environment variables to set for install and check processes while 80 | #' running the reverse dependency check 81 | #' 82 | #' @param force_suggests Whether to force the installation of the 83 | #' suggested packages. 84 | #' @return Named character vector. 85 | #' 86 | #' @export 87 | 88 | revdep_env_vars <- function(force_suggests = FALSE) { 89 | c( 90 | # Switch off expensive check for package version 91 | # https://github.com/hadley/devtools/issues/1271 92 | if ( 93 | getRversion() >= "3.4.0" && as.numeric(R.version[["svn rev"]]) >= 70944 94 | ) { 95 | c("_R_CHECK_CRAN_INCOMING_REMOTE_" = "FALSE") 96 | } else { 97 | c("_R_CHECK_CRAN_INCOMING_" = "FALSE") 98 | }, 99 | "_R_CHECK_FORCE_SUGGESTS_" = as.character(force_suggests), 100 | "RGL_USE_NULL" = "TRUE", 101 | DISPLAY = "", 102 | RSTUDIO = 0, 103 | RSTUDIO_CONSOLE_WIDTH = 80, 104 | R_COMPILE_AND_INSTALL_PACKAGES = "never" 105 | ) 106 | } 107 | 108 | check_done <- function(state, worker) { 109 | starttime <- worker$process$get_start_time() 110 | duration <- as.numeric(Sys.time() - starttime) 111 | wpkg <- match(worker$package, state$packages$package) 112 | 113 | current_state <- state$packages$state[wpkg] 114 | my_task <- worker$task 115 | iam_old <- my_task$args[[2]] == "old" 116 | 117 | new_state <- 118 | if (current_state == "checking" && iam_old) { 119 | "done-downloaded" 120 | } else if (current_state == "checking-checking" && iam_old) { 121 | "done-checking" 122 | } else if (current_state == "checking-checking" && !iam_old) { 123 | "checking-done" 124 | } else if (current_state == "checking-done" && iam_old) { 125 | cleanup_library(state, worker) 126 | "done" 127 | } else if (current_state == "done-checking" && !iam_old) { 128 | cleanup_library(state, worker) 129 | "done" 130 | } else { 131 | stop("Internal revdepcheck error, invalid state") 132 | } 133 | state$packages$state[wpkg] <- new_state 134 | 135 | chkres <- if (isTRUE(worker$killed)) { 136 | "Process was killed while checking" 137 | } else { 138 | tryCatch( 139 | worker$process$parse_results(), 140 | error = function(e) e 141 | ) 142 | } 143 | 144 | cleanup_chkres(state, worker, iam_old) 145 | 146 | status <- if (isTRUE(worker$killed)) { 147 | "TIMEOUT" 148 | } else if (!inherits(chkres, "rcmdcheck")) { 149 | "PREPERROR" 150 | } else if (length(chkres$errors)) { 151 | "ERROR" 152 | } else if (length(chkres$warnings)) { 153 | "WARNING" 154 | } else if (length(chkres$notes)) { 155 | "NOTE" 156 | } else { 157 | "OK" 158 | } 159 | 160 | summary <- list( 161 | errors = length(chkres$errors), 162 | warnings = length(chkres$warnings), 163 | notes = length(chkres$notes) 164 | ) 165 | 166 | description <- desc::desc(text = chkres$description) 167 | maintainer <- description$get_maintainer() 168 | 169 | db_insert( 170 | state$options$pkgdir, 171 | worker$package, 172 | version = chkres$version, 173 | maintainer = maintainer, 174 | status = status, 175 | which = my_task$args[[2]], 176 | duration = duration, 177 | starttime = as.character(starttime), 178 | result = unclass(toJSON(chkres)), 179 | summary = unclass(toJSON(summary)) 180 | ) 181 | 182 | if (new_state == "done") { 183 | clear_line() 184 | 185 | comparison <- db_results(state$options$pkgdir, worker$package)[[1]] 186 | print(summary(comparison)) 187 | 188 | state$progress_bar$tick(tokens = list(packages = checking_now(state))) 189 | } 190 | 191 | state 192 | } 193 | 194 | check <- function(pkgdir, pkgname, iam_old = TRUE) { 195 | proc <- check_proc(pkgdir, pkgname, iam_old) 196 | proc$wait() 197 | 198 | res <- proc$parse_results() 199 | print(res) 200 | 201 | invisible(res) 202 | } 203 | 204 | library_info <- function(file = "", libpath = .libPaths()) { 205 | libraries <- map(libpath, installed.packages) 206 | 207 | package_list <- function(library) { 208 | nv <- paste0(format(library[, "Package"]), " (", library[, "Version"], ")") 209 | paste0(nv, "\n", collapse = "") 210 | } 211 | 212 | library_sum <- map_chr(libraries, package_list) 213 | cat( 214 | paste0("Library: ", libpath, "\n", library_sum, collapse = "\n"), 215 | file = file 216 | ) 217 | } 218 | -------------------------------------------------------------------------------- /R/email.R: -------------------------------------------------------------------------------- 1 | #' List maintainers of all reverse dependencies 2 | #' 3 | #' @export 4 | #' @inheritParams revdep_check 5 | revdep_maintainers <- function(pkg = ".") { 6 | pkg <- pkg_check(pkg) 7 | 8 | m <- db_maintainers(pkg) 9 | structure(m, class = "revdepcheck_maintainers") 10 | } 11 | 12 | #' @export 13 | print.revdepcheck_maintainers <- function(x, ...) { 14 | cat_line(paste0(names(x), " - ", x, collapse = ",\n")) 15 | } 16 | 17 | #' Notify revdep maintainers about problems 18 | #' 19 | #' This function uses gmail to automatically notify all maintainers of revdeps 20 | #' that have failures with the new version of the package. The form of the 21 | #' email is fixed, but it uses template parameters so that you can control 22 | #' the details: set the variables in `revdeps/email.yaml`. You'll be prompted to 23 | #' review the template before any emails are sent; or you can use 24 | #' `revdep_email_draft()` to see a draft version. 25 | #' 26 | #' To use this function, you'll need to give the gmailr app authority to 27 | #' send emails from gmail. To revoke that authority, delete the `.httr-oauth` 28 | #' file created in your working directory. 29 | #' 30 | #' @inheritParams revdep_check 31 | #' @param type Type of problems to notify about; either "broken" (i.e. there 32 | #' is a new `R CMD check` failure that did not currently occur) or 33 | #' "failed" (i.e. the check failure either during installation or because 34 | #' of a timeout). 35 | #' @param packages A character vector of package names. Use this if some emails 36 | #' failed to send in the previous round. If omitted uses all packages. 37 | #' @param data Optionally, supply a named list to provide your own parameters 38 | #' to fill in the template 39 | #' @param draft If `TRUE`, create a gmail draft rather than sending the email 40 | #' directly. 41 | #' @export 42 | 43 | revdep_email <- function( 44 | type = c("broken", "failed"), 45 | pkg = ".", 46 | packages = NULL, 47 | draft = FALSE 48 | ) { 49 | type <- match.arg(type) 50 | 51 | packages <- db_results(pkg, packages) 52 | status <- map_chr(packages, rcmdcheck_status) 53 | 54 | cond <- switch( 55 | type, 56 | broken = status %in% c("-", "t-", "i-"), 57 | failed = status %in% c("i+", "t+") 58 | ) 59 | revdep_email_by_type(pkg, packages[cond], type, draft = draft) 60 | 61 | invisible() 62 | } 63 | 64 | revdep_email_by_type <- function( 65 | pkg, 66 | packages, 67 | type = "broken", 68 | draft = FALSE 69 | ) { 70 | if (length(packages) == 0) { 71 | message("All ok :D") 72 | return(invisible()) 73 | } 74 | 75 | # Generate email templates 76 | package_data <- package_data(pkg = pkg, packages = packages) 77 | 78 | # Show draft email (using first package) and check we're good 79 | revdep_email_draft(pkg = pkg, type = type, data = package_data[[1]]) 80 | 81 | ready <- utils::menu( 82 | title = paste0("Ready to send ", length(package_data), " emails?"), 83 | c("Yes", "No") 84 | ) 85 | 86 | if (ready != 1L) { 87 | return(invisible()) 88 | } 89 | 90 | ok <- logical(length(package_data)) 91 | 92 | # Construct and send each email 93 | for (i in seq_along(package_data)) { 94 | data <- package_data[[i]] 95 | 96 | body <- email_build(type = type, data = data) 97 | to <- data$your_email 98 | subject <- glue_data( 99 | data, 100 | "{your_package} and upcoming CRAN release of {my_package}" 101 | ) 102 | 103 | ok[[i]] <- email_send(to, body, subject, draft = draft) 104 | } 105 | 106 | if (any(!ok)) { 107 | failed <- package_data[!ok] 108 | pkgs <- map_chr(failed, function(x) x$your_package) 109 | 110 | message("Failed to send:") 111 | cat(deparse(pkgs), sep = "\n") 112 | } 113 | 114 | invisible() 115 | } 116 | 117 | #' @export 118 | #' @rdname revdep_email 119 | 120 | revdep_email_draft <- function( 121 | type = "broken", 122 | pkg = ".", 123 | data = email_data(pkg) 124 | ) { 125 | cat_line(rule("Draft email")) 126 | 127 | data <- map(data, bold) 128 | cat(email_build(type = type, data = data)) 129 | 130 | cat_line() 131 | cat_line() 132 | cat_line(rule()) 133 | cat_line("Please carefully review this draft") 134 | cat_line("Missing variables look like ", red("--field_name--")) 135 | cat_line("Add these to revdep/email.yml") 136 | cat_line(rule()) 137 | } 138 | 139 | 140 | # Internal -------------------------------------------------------------- 141 | 142 | package_data <- function(packages, pkg = ".") { 143 | data_base <- email_data(pkg) 144 | data_package <- map(packages, function(x) { 145 | cmp <- x$cmp 146 | old <- unique(cmp$hash[cmp$which == "old"]) 147 | new <- unique(cmp$hash[cmp$which == "new"]) 148 | broke <- setdiff(new, old) 149 | 150 | idx <- switch( 151 | x$status, 152 | "-" = cmp$hash %in% broke & cmp$which == "new", 153 | "t-" = , 154 | "i-" = cmp$which == "new" 155 | ) 156 | out <- cmp$output[idx] 157 | your_results <- crayon::strip_style(format_details_bullets(out)) 158 | 159 | desc <- desc::desc(text = x$new$description) 160 | maintainer <- utils::as.person(desc$get_maintainer())[[1]] 161 | 162 | list( 163 | your_package = x$package, 164 | your_version = desc$get_version(), 165 | your_results = glue::glue_collapse(your_results), 166 | your_name = format(maintainer, c("given", "family")), 167 | your_email = format(maintainer, "email", braces = list(email = "")) 168 | ) 169 | }) 170 | map(data_package, function(x) utils::modifyList(data_base, x)) 171 | } 172 | 173 | #' @importFrom gmailr mime send_message 174 | 175 | email_send <- function(to, body, subject, draft = TRUE) { 176 | email <- mime(To = to, Subject = subject, body = body) 177 | 178 | send <- if (draft) gmailr::create_draft else gmailr::send_message 179 | msg <- if (draft) "Drafting" else "Sending" 180 | tryCatch( 181 | { 182 | message(msg, ": ", gmailr::subject(email)) 183 | send(email) 184 | TRUE 185 | }, 186 | interrupt = function(e) { 187 | message("Aborted by user") 188 | invokeRestart("abort") 189 | }, 190 | error = function(e) { 191 | message("Failed") 192 | FALSE 193 | } 194 | ) 195 | } 196 | 197 | 198 | #' @importFrom glue glue_data 199 | 200 | email_build <- function(type = "broken", data = email_data(".")) { 201 | name <- paste0("email-", type, ".txt") 202 | template_path <- system.file( 203 | "templates", 204 | name, 205 | package = "revdepcheck", 206 | mustWork = TRUE 207 | ) 208 | 209 | template <- paste(readLines(template_path), collapse = "\n") 210 | glue_data(data, template) 211 | } 212 | 213 | #' @importFrom whoami fullname 214 | #' @importFrom yaml yaml.load_file as.yaml 215 | 216 | email_data <- function(pkg = ".") { 217 | pkg <- pkg_check(pkg) 218 | 219 | defaults <- email_data_defaults(pkg) 220 | 221 | yaml_path <- file.path(pkg, "revdep", "email.yml") 222 | if (!file.exists(yaml_path)) { 223 | return(defaults) 224 | } 225 | 226 | manual <- compact(yaml.load_file(yaml_path)) 227 | utils::modifyList(defaults, manual) 228 | } 229 | 230 | email_data_defaults <- function(pkg = ".") { 231 | pkg <- pkg_check(pkg) 232 | 233 | list( 234 | my_package = pkg_name(pkg), 235 | my_version = pkg_version(pkg), 236 | my_name = fullname(red("--my_name--")), 237 | my_news_url = red("--my_news_url--"), 238 | my_issues_url = pkg_bug_reports(pkg), 239 | 240 | release_date = red("--release_date--"), 241 | rel_release_date = red("--rel_release_date--"), 242 | release_version = red("--release_version--"), 243 | release_details = red("--release_details--"), 244 | 245 | your_package = green("your_package"), 246 | your_version = green("your_version"), 247 | your_results = green("your_results"), 248 | your_name = green("your_name") 249 | ) 250 | } 251 | -------------------------------------------------------------------------------- /R/revdepcheck.R: -------------------------------------------------------------------------------- 1 | #' Run revdep checks 2 | #' 3 | #' @description 4 | #' `revdep_check()` runs `R CMD check` on all reverse dependencies of your 5 | #' package. To avoid false positives, it runs `R CMD check` twice: once for 6 | #' released version on CRAN and once for the local development version. It 7 | #' then reports the differences so you can see what checks were previously 8 | #' ok but now fail. 9 | #' 10 | #' It requires to use a repos option that provides the source code of the packages not binaries. 11 | #' 12 | #' Once your package has been successfully submitted to CRAN, you should 13 | #' run `revdep_reset()`. This deletes all files used for checking, freeing 14 | #' up disk space and leaving you in a clean state for the next release. 15 | #' 16 | #' @details 17 | #' `revdep_check()` proceeds in four steps: 18 | #' 19 | #' 1. **Init**: create the `revdep/` subdirectory if it doesn't already exist, 20 | #' and save the list of reverse dependencies to check. 21 | #' 22 | #' 1. **Install**: install the CRAN (released) and local (development) 23 | #' versions of your package, including all dependencies. 24 | #' 25 | #' 1. **Run**: run `R CMD check` twice for each reverse dependency, once 26 | #' for the CRAN version and one for the local version. The checks are 27 | #' run in parallel using `num_worker` processes. 28 | #' 29 | #' 1. **Report**: generate reports showing differences between the check 30 | #' results for the CRAN and local versions of your package. The focus of 31 | #' the report is on new failures. The reports are saved in `revdep/`. 32 | #' 33 | #' `revdep_check()` is designed to seamlessly resume in the case of failure: 34 | #' just re-run `revdep_check()` and it will start from where it left off. 35 | #' If you want to start again from scratch, run `revdep_reset()`. 36 | #' 37 | #' @param pkg Path to package. 38 | #' @param dependencies Which types of revdeps should be checked. For CRAN 39 | #' release, we recommend using the default. 40 | #' @param quiet Suppress output from internal processes? 41 | #' @param timeout Maximum time to wait (in seconds) for `R CMD check` to 42 | #' complete. Default is 10 minutes. 43 | #' @param num_workers Number of parallel workers to use 44 | #' @param bioc Also check revdeps that live in Bioconductor? 45 | #' @param cran Should cran mirror be attached to getOpion("repos") if it 46 | #' is not already present. 47 | #' @param env Environment variables to set for the install and check 48 | #' processes. See [revdep_env_vars()]. 49 | #' 50 | #' @seealso To see more details of problems during a run, call 51 | #' [revdep_summary()] and [revdep_details()] in another process. 52 | #' 53 | #' @export 54 | #' @importFrom remotes install_local 55 | #' @importFrom withr with_libpaths with_envvar 56 | #' @importFrom crancache install_packages 57 | 58 | revdep_check <- function( 59 | pkg = ".", 60 | dependencies = c("Depends", "Imports", "Suggests", "LinkingTo"), 61 | quiet = TRUE, 62 | timeout = as.difftime(10, units = "mins"), 63 | num_workers = 1, 64 | bioc = TRUE, 65 | cran = TRUE, 66 | env = revdep_env_vars() 67 | ) { 68 | pkg <- pkg_check(pkg) 69 | dir_setup(pkg) 70 | if (!db_exists(pkg)) { 71 | db_setup(pkg) 72 | } 73 | 74 | did_something <- FALSE 75 | repeat { 76 | stage <- db_metadata_get(pkg, "todo") %|0|% "init" 77 | switch( 78 | stage, 79 | init = revdep_init( 80 | pkg, 81 | dependencies = dependencies, 82 | bioc = bioc, 83 | cran = cran 84 | ), 85 | install = revdep_install( 86 | pkg, 87 | quiet = quiet, 88 | env = env, 89 | bioc = bioc, 90 | cran = cran 91 | ), 92 | run = revdep_run( 93 | pkg, 94 | quiet = quiet, 95 | timeout = timeout, 96 | num_workers = num_workers, 97 | env = env, 98 | bioc = bioc, 99 | cran = cran 100 | ), 101 | report = revdep_final_report(pkg, bioc = bioc, cran = cran), 102 | done = break 103 | ) 104 | did_something <- TRUE 105 | } 106 | 107 | if (!did_something) { 108 | message( 109 | "* See results of previous run in 'revdep/README.md'\n", 110 | "* Reset for another run with `revdepcheck::revdep_reset()`" 111 | ) 112 | } 113 | 114 | invisible() 115 | } 116 | 117 | revdep_setup <- function(pkg = ".") { 118 | pkg <- pkg_check(pkg) 119 | status("SETUP") 120 | 121 | message("Creating directories and database") 122 | 123 | invisible() 124 | } 125 | 126 | 127 | revdep_init <- function( 128 | pkg = ".", 129 | dependencies = c("Depends", "Imports", "Suggests", "LinkingTo"), 130 | bioc = TRUE, 131 | cran = TRUE 132 | ) { 133 | pkg <- pkg_check(pkg) 134 | pkgname <- pkg_name(pkg) 135 | db_clean(pkg) # Delete all records 136 | 137 | "!DEBUG getting reverse dependencies for `basename(pkg)`" 138 | status("INIT", "Computing revdeps") 139 | revdeps <- cran_revdeps(pkgname, dependencies, bioc = bioc, cran = cran) 140 | db_todo_add(pkg, revdeps) 141 | 142 | db_metadata_set(pkg, "todo", "install") 143 | db_metadata_set(pkg, "bioc", as.character(bioc)) 144 | db_metadata_set(pkg, "dependencies", paste(dependencies, collapse = ";")) 145 | 146 | invisible() 147 | } 148 | 149 | revdep_install <- function( 150 | pkg = ".", 151 | quiet = FALSE, 152 | env = character(), 153 | bioc = bioc, 154 | cran = TRUE 155 | ) { 156 | pkg <- pkg_check(pkg) 157 | pkgname <- pkg_name(pkg) 158 | 159 | status("INSTALL", "2 versions") 160 | 161 | dir_create(dir_find(pkg, "old")) 162 | dir_create(dir_find(pkg, "new")) 163 | 164 | ## Install the package itself, both versions, first the CRAN version 165 | ## We instruct crancache to only use the cache of CRAN packages 166 | ## (to avoid installing locally installed newer versions. 167 | "!DEBUG Installing CRAN (old) version" 168 | message("Installing CRAN version of ", pkgname) 169 | package_name <- pkg_name(pkg)[[1]] 170 | 171 | # we don't want to fail on aarch64 because there are no binary bioc 172 | # packages for that 173 | fail_on_warn <- Sys.info()[["sysname"]] != "Darwin" || 174 | R.Version()$arch != "aarch64" 175 | 176 | with_envvar( 177 | c(CRANCACHE_REPOS = "cran,bioc", CRANCACHE_QUIET = "yes", env), 178 | with_libpaths( 179 | dir_find(pkg, "old"), 180 | rlang::with_options( 181 | warn = if (fail_on_warn) 2 else 1, 182 | install_packages( 183 | pkgname, 184 | quiet = quiet, 185 | repos = get_repos(bioc = bioc, cran = cran), 186 | upgrade = "always" 187 | ) 188 | ) 189 | ) 190 | ) 191 | 192 | ## Now the new version 193 | "!DEBUG Installing new version from `pkg`" 194 | message("Installing DEV version of ", pkgname) 195 | with_envvar( 196 | c(CRANCACHE_REPOS = "cran,bioc", CRANCACHE_QUIET = "yes", env), 197 | with_libpaths( 198 | dir_find(pkg, "new"), 199 | rlang::with_options( 200 | warn = if (fail_on_warn) 2 else 1, 201 | install_local( 202 | pkg, 203 | quiet = quiet, 204 | repos = get_repos(bioc = bioc, cran = cran), 205 | force = TRUE, 206 | upgrade = "always" 207 | ) 208 | ) 209 | ) 210 | ) 211 | 212 | # Record libraries 213 | lib <- library_compare(pkg) 214 | utils::write.csv( 215 | lib, 216 | file.path(dir_find(pkg, "checks"), "libraries.csv"), 217 | row.names = FALSE, 218 | quote = FALSE 219 | ) 220 | 221 | db_metadata_set(pkg, "todo", "run") 222 | invisible() 223 | } 224 | 225 | #' @importFrom prettyunits vague_dt 226 | 227 | revdep_run <- function( 228 | pkg = ".", 229 | quiet = TRUE, 230 | timeout = as.difftime(10, units = "mins"), 231 | num_workers = 1, 232 | bioc = TRUE, 233 | env = character(), 234 | cran = TRUE 235 | ) { 236 | pkg <- pkg_check(pkg) 237 | pkgname <- pkg_name(pkg) 238 | 239 | if (!inherits(timeout, "difftime")) { 240 | timeout <- as.difftime(timeout, units = "secs") 241 | } 242 | 243 | todo <- db_todo(pkg) 244 | status("CHECK", paste0(length(todo), " packages")) 245 | start <- Sys.time() 246 | 247 | state <- list( 248 | options = list( 249 | pkgdir = pkg, 250 | pkgname = pkgname, 251 | quiet = quiet, 252 | timeout = timeout, 253 | num_workers = num_workers, 254 | env = env, 255 | bioc = bioc, 256 | cran = cran 257 | ), 258 | packages = data.frame( 259 | package = todo, 260 | state = if (length(todo)) "todo" else character(), 261 | stringsAsFactors = FALSE 262 | ) 263 | ) 264 | 265 | run_event_loop(state) 266 | end <- Sys.time() 267 | 268 | status <- report_status(pkg) 269 | cat_line(green("OK: "), status$ok) 270 | cat_line(red("BROKEN: "), status$broken) 271 | cat_line("Total time: ", vague_dt(end - start, format = "short")) 272 | 273 | db_metadata_set(pkg, "todo", "report") 274 | invisible() 275 | } 276 | 277 | revdep_final_report <- function(pkg = ".", bioc = TRUE, cran = TRUE) { 278 | db_metadata_set(pkg, "todo", "done") 279 | status("REPORT") 280 | revdep_report(pkg, bioc = bioc, cran = cran) 281 | } 282 | 283 | report_exists <- function(pkg) { 284 | root <- dir_find(pkg, "root") 285 | file.exists(file.path(root, "README.md")) && 286 | file.exists(file.path(root, "problems.md")) 287 | } 288 | 289 | #' @export 290 | #' @rdname revdep_check 291 | 292 | revdep_reset <- function(pkg = ".") { 293 | pkg <- pkg_check(pkg) 294 | 295 | db_disconnect(pkg) 296 | 297 | unlink(dir_find(pkg, "lib"), recursive = TRUE) 298 | unlink(dir_find(pkg, "checks"), recursive = TRUE) 299 | unlink(dir_find(pkg, "db"), recursive = TRUE) 300 | 301 | invisible() 302 | } 303 | 304 | #' @importFrom crayon bold 305 | 306 | status <- function(title, info = "") { 307 | cat_line(rule(left = bold(title), right = info)) 308 | } 309 | -------------------------------------------------------------------------------- /R/event-loop.R: -------------------------------------------------------------------------------- 1 | #' This is the event loop of the revdep check process 2 | #' 3 | #' @param state The full state of the check process: 4 | #' * `options` contains all check parameters. 5 | #' * `packages` is a data frame with the packages to check. 6 | #' See details below. 7 | #' 8 | #' @details 9 | #' `state$packages` is a data frame with columns: 10 | #' * `package`: the name of the package 11 | #' * `state`: where we are with its check. Possible values: 12 | #' * `todo`: haven't done anything yet 13 | #' * `deps_installing`: the dependencies are being installed now 14 | #' * `deps_installed`: the dependencies were already installed 15 | #' * `downloading`: the source package to check is being downloaded 16 | #' * `downloaded`: the source package was downloaded 17 | #' * `checking`: checking with the old version right now 18 | #' * `checking-checking`: checking with both versions right now 19 | #' * `done-checking`: done with the old version, checking with the new 20 | #' version right now 21 | #' * `checking-done`: checking with the old version, new version was 22 | #' already done. 23 | #' * `done-downloaded`: done with the old version, check with new 24 | #' version has not started yet 25 | #' * `done`: packages was checked with both versions 26 | #' 27 | #' We only start the check with the new version after the check with the 28 | #' old version, which simplifies the state transitions a bit. 29 | #' 30 | #' @keywords internal 31 | #' @importFrom progress progress_bar 32 | 33 | run_event_loop <- function(state) { 34 | "!DEBUG running event loop" 35 | 36 | if (nrow(state$packages) == 0) { 37 | return() 38 | } 39 | 40 | ## Kill all child processes if we quit from this function 41 | on.exit(remove_workers(state), add = TRUE) 42 | 43 | ## This is a list of worker processes 44 | state$workers <- list() 45 | 46 | ## Our global progress bar 47 | state$progress_bar <- progress_bar$new( 48 | total = nrow(state$packages), 49 | format = "[:current/:total] :elapsedfull | ETA: :eta | :packages" 50 | ) 51 | 52 | # Initialise one task for each worker 53 | for (i in seq_len(state$options$num_workers)) { 54 | state$progress_bar$tick(0, tokens = list(packages = checking_now(state))) 55 | task <- schedule_next_task(state) 56 | state <- do_task(state, task) 57 | } 58 | 59 | while (1) { 60 | "!DEBUG event loop iteration, `length(state$workers)` workers" 61 | check_for_timeouts(state) 62 | if (are_we_done(state)) { 63 | break 64 | } 65 | state$progress_bar$tick(0, tokens = list(packages = checking_now(state))) 66 | events <- poll(state) 67 | state <- handle_events(state, events) 68 | task <- schedule_next_task(state) 69 | state <- do_task(state, task) 70 | if ( 71 | package_version(getNamespaceVersion(asNamespace("processx"))) <= "3.0.0" 72 | ) { 73 | gc() 74 | } 75 | } 76 | 77 | "!DEBUG event loop is done" 78 | NULL 79 | } 80 | 81 | ## In case of a timeout, we just kill the process here. 82 | ## This will trigger an event for it, that will be picked up by 83 | ## handle_events(). If we failed to kill it (because it finished, just 84 | ## before the kill signal, that is fine, too, then handle_events() 85 | ## will consider it as a normal termination. 86 | 87 | check_for_timeouts <- function(state) { 88 | now <- Sys.time() 89 | for (w in state$workers) { 90 | if ( 91 | now - w$process$get_start_time() > state$options$timeout && 92 | w$process$is_alive() 93 | ) { 94 | "!DEBUG Killing worker for package `w$package`" 95 | w$killed <- TRUE 96 | w$process$kill(close_connections = FALSE) 97 | } 98 | } 99 | } 100 | 101 | are_we_done <- function(state) { 102 | all(state$packages$state == "done") 103 | } 104 | 105 | checking_now <- function(state) { 106 | workers <- compact(state$workers) 107 | if (length(workers) == 0) { 108 | return("") 109 | } 110 | 111 | pkgs <- map_chr(workers, "[[", "package") 112 | wstate <- state$packages[state$packages$package %in% pkgs, ] 113 | width <- getOption("width") - 38 # conservative estimate 114 | upkgs <- unique(pkgs) 115 | ustate <- wstate$state[match(upkgs, wstate$package)] 116 | sum_lookup <- c( 117 | "todo" = "??", 118 | "deps_installing" = "I", 119 | "deps_installed" = "I", 120 | "downloading" = "D", 121 | "downloaded" = "D", 122 | "checking" = "C_", 123 | "checking-checking" = "CC", 124 | "done-checking" = "vC", 125 | "checking-done" = "Cv", 126 | "done-downloaded" = "vD", 127 | "done" = "vv" 128 | ) 129 | str <- paste0(upkgs, " [", sum_lookup[ustate], "]", collapse = ", ") 130 | paste0("(", length(pkgs), ") ", str_trunc(str, width)) 131 | } 132 | 133 | poll <- function(state) { 134 | if (length(state$workers)) { 135 | timeout <- get_timeout(state) 136 | procs <- map(state$workers, function(x) x$process) 137 | 138 | "!DEBUG poll with timeout of `timeout` ms" 139 | res <- processx::poll(procs, ms = timeout) 140 | map_lgl(res, function(x) "ready" %in% x) 141 | } else { 142 | "!DEBUG nothing to poll" 143 | logical() 144 | } 145 | } 146 | 147 | get_timeout <- function(state) { 148 | ts <- map_dbl( 149 | state$workers, 150 | get_process_waiting_time, 151 | timeout = state$options$timeout 152 | ) 153 | max(min(ts, 200), 0) 154 | } 155 | 156 | get_process_waiting_time <- function(worker, timeout) { 157 | have_time <- timeout - (Sys.time() - worker$process$get_start_time()) 158 | units(have_time) <- "secs" 159 | as.integer(max(as.numeric(have_time) * 1000, 0)) 160 | } 161 | 162 | handle_events <- function(state, events) { 163 | for (i in which(events)) { 164 | state <- handle_event(state, i) 165 | } 166 | state$workers <- drop_nulls(state$workers) 167 | state 168 | } 169 | 170 | handle_event <- function(state, which) { 171 | "!DEBUG handle event, package `state$workers[[which]]$package`" 172 | proc <- state$workers[[which]]$process 173 | 174 | ## Read out stdout and stderr. If process is done, then read out all 175 | if (proc$is_alive()) { 176 | state$workers[[which]]$stdout <- 177 | c(state$workers[[which]]$stdout, out <- proc$read_output(n = 10000)) 178 | if (proc$has_error_connection()) { 179 | state$workers[[which]]$stderr <- 180 | c(state$workers[[which]]$stderr, err <- proc$read_error(n = 10000)) 181 | } else { 182 | state$workers[[which]]$stderr <- "" 183 | } 184 | } else { 185 | state$workers[[which]]$stdout <- 186 | c(state$workers[[which]]$stdout, out <- proc$read_all_output()) 187 | if (proc$has_error_connection()) { 188 | state$workers[[which]]$stderr <- 189 | c(state$workers[[which]]$stderr, err <- proc$read_all_error()) 190 | } else { 191 | state$workers[[which]]$stderr <- "" 192 | } 193 | } 194 | 195 | "!DEBUG read out `nchar(out)`/`nchar(err)` characters" 196 | 197 | ## If there is still output, then wait a bit more 198 | if ( 199 | proc$is_incomplete_output() || 200 | (proc$has_error_connection() && proc$is_incomplete_error()) 201 | ) { 202 | return(state) 203 | } 204 | 205 | ## Otherwise update the state, and the DB 206 | worker <- state$workers[[which]] 207 | state$workers[which] <- list(NULL) 208 | 209 | ## Cut stdout and stderr to lines 210 | worker$stdout <- cut_into_lines(worker$stdout) 211 | worker$stderr <- cut_into_lines(worker$stderr) 212 | 213 | if (worker$task$name == "deps_install") { 214 | deps_install_done(state, worker) 215 | } else if (worker$task$name == "download") { 216 | download_done(state, worker) 217 | } else if (worker$task$name == "check") { 218 | check_done(state, worker) 219 | } 220 | } 221 | 222 | #' Decide what to do next, from the current state 223 | #' 224 | #' In we have reached the allowed number of workers, then we schedule an 225 | #' idle job, we just need to wait until a worker is done. 226 | #' 227 | #' Otherwise we schedule a job. In general the strategy is to finish check 228 | #' as soon as possible, so if a package is in `deps_installed`, then we 229 | #' schedule a check. Otherwise, if a package is in `todo`, then we 230 | #' schedule a dependency install. 231 | #' 232 | #' If there is nothing we can do now, then we schedule an idle job, i.e. 233 | #' just wait until a worker gets done. 234 | #' 235 | #' @param state See [run_event_loop()] for a description. 236 | #' 237 | #' @keywords internal 238 | 239 | schedule_next_task <- function(state) { 240 | "!DEBUG schedule next task" 241 | 242 | ## Cannot run more workers? 243 | if (length(state$workers) >= state$options$num_workers) { 244 | "!DEBUG schedule an idle task" 245 | return(task("idle")) 246 | } 247 | 248 | ## done-downloaded -> done-checking 249 | ready <- state$packages$state == "done-downloaded" 250 | if (any(ready)) { 251 | pkg <- state$packages$package[ready][1] 252 | return(task("check", pkg, "new")) 253 | } 254 | 255 | ## checking -> checking-checking 256 | ready <- state$packages$state == "checking" 257 | if (any(ready)) { 258 | pkg <- state$packages$package[ready][1] 259 | "!DEBUG schedule checking `pkg` with the new version" 260 | return(task("check", pkg, "new")) 261 | } 262 | 263 | ## downloaded -> checking 264 | ready <- state$packages$state == "downloaded" 265 | if (any(ready)) { 266 | pkg <- state$packages$package[ready][1] 267 | "!DEBUG schedule checking `pkg` with the old version" 268 | return(task("check", pkg, "old")) 269 | } 270 | 271 | ## deps_installed -> downloading 272 | ready <- state$packages$state == "deps_installed" 273 | if (any(ready)) { 274 | pkg <- state$packages$package[ready][1] 275 | "!DEBUG schedule downloading `pkg` with the old version" 276 | return(task("download", pkg, 1L)) 277 | } 278 | 279 | ## todo -> deps_installing 280 | ready <- state$packages$state == "todo" 281 | if (any(ready)) { 282 | pkg <- state$packages$package[ready][1] 283 | "!DEBUG schedule dependency installs for `pkg`" 284 | return(task("deps_install", pkg)) 285 | } 286 | 287 | task("idle") 288 | } 289 | 290 | task <- function(name, ...) { 291 | list(name = name, args = list(...)) 292 | } 293 | 294 | do_task <- function(state, task) { 295 | if (task$name == "idle") { 296 | ## Do nothing, return the state as it is 297 | "!DEBUG do an idle task" 298 | state 299 | } else if (task$name == "deps_install") { 300 | "!DEBUG do a dependency install task: `task[[2]]`" 301 | deps_install_task(state, task) 302 | } else if (task$name == "download") { 303 | "!DEBUG do a download task: `task[[2]]`" 304 | download_task(state, task) 305 | } else if (task$name == "check") { 306 | "!DEBUG do a check task: `task[[2]]`" 307 | check_task(state, task) 308 | } else { 309 | stop("Unknown task") 310 | } 311 | } 312 | 313 | remove_workers <- function(state) { 314 | "!DEBUG remove `length(state$workers)` workers" 315 | for (w in state$workers) { 316 | w$process$kill() 317 | } 318 | } 319 | -------------------------------------------------------------------------------- /R/db.R: -------------------------------------------------------------------------------- 1 | dbenv <- new.env() 2 | 3 | db_version <- "3.0.0" 4 | 5 | #' @importFrom RSQLite dbIsValid dbConnect SQLite 6 | 7 | db <- function(package) { 8 | if ( 9 | exists(package, envir = dbenv) && 10 | dbIsValid(con <- dbenv[[package]]) 11 | ) { 12 | con 13 | } else if (package == ":memory:") { 14 | dbenv[[package]] <- dbConnect(SQLite(), ":memory:") 15 | dbenv[[package]] 16 | } else { 17 | if (!file.exists(dir_find(package))) { 18 | stop("Please start by running `revdep_check()`", call. = FALSE) 19 | } 20 | 21 | dbenv[[package]] <- dbConnect(SQLite(), dir_find(package, "db")) 22 | db_check_version(package) 23 | dbenv[[package]] 24 | } 25 | } 26 | 27 | db_disconnect <- function(package) { 28 | if (!exists(package, envir = dbenv)) { 29 | return() 30 | } 31 | 32 | con <- dbenv[[package]] 33 | if (dbIsValid(con)) { 34 | DBI::dbDisconnect(con) 35 | } 36 | 37 | rm(list = package, envir = dbenv) 38 | } 39 | 40 | db_check_version <- function(package) { 41 | db <- db(package) 42 | ## If not metadata table, we just assume that the DB is empty 43 | if (!dbExistsTable(db, "metadata")) { 44 | return() 45 | } 46 | dbver <- dbGetQuery( 47 | db, 48 | "SELECT value FROM metadata WHERE name = 'dbversion'" 49 | ) 50 | rdver <- dbGetQuery( 51 | db, 52 | "SELECT value FROM metadata WHERE name = 'revdepcheckversion'" 53 | ) 54 | if (dbver[1, 1] != db_version) { 55 | verstr <- if (nrow(rdver)) rdver[1, 1] else "< 1.0.0.9001" 56 | stop( 57 | "This revdep DB was created by revdepcheck ", 58 | verstr, 59 | ". ", 60 | "You can use `revdep_reset()` to remove the DB, or you can ", 61 | "install a different version of revdepcheck." 62 | ) 63 | } 64 | } 65 | 66 | #' Make sure that the database exists 67 | #' 68 | #' @param package The name of the package under revdep cheking. 69 | #' @return Nothing 70 | #' 71 | #' @keywords internal 72 | #' @importFrom DBI dbExecute 73 | 74 | db_setup <- function(package) { 75 | db <- db(package) 76 | 77 | dbExecute(db, "DROP TABLE IF EXISTS revdeps") 78 | dbExecute(db, "DROP TABLE IF EXISTS metadata") 79 | dbExecute(db, "DROP TABLE IF EXISTS todo") 80 | 81 | dbExecute(db, "CREATE TABLE metadata (name TEXT, value TEXT)") 82 | 83 | db_metadata_init(package) 84 | 85 | ## Every NOTE, WARNING or ERROR is a separate record in the DB. 86 | ## The whole standard output is also stored with type 'OUTPUT'. 87 | ## Contents 00install.out file will be stored as INSTALL_OUT, if 88 | ## there were any errors. PREPERROR means that there was an error 89 | ## before starting the actual check 90 | dbExecute( 91 | db, 92 | "CREATE TABLE revdeps ( 93 | package TEXT, 94 | version TEXT, 95 | maintainer TEXT, 96 | status TEXT, -- PREPERROR, INSTALLERROR, ERROR, WARNING, OK 97 | which TEXT, 98 | duration TEXT, -- seconds 99 | starttime TEXT, -- when the check was performed 100 | result TEXT, -- JSON, unparsed outputs 101 | summary TEXT -- JSON, parsed outputs 102 | )" 103 | ) 104 | dbExecute(db, "CREATE INDEX idx_revdeps_package ON revdeps(package)") 105 | 106 | dbExecute(db, "CREATE TABLE todo (package TEXT PRIMARY KEY, status TEXT)") 107 | 108 | invisible(db) 109 | } 110 | 111 | db_metadata_init <- function(package) { 112 | db_metadata_set(package, "dbversion", db_version) 113 | db_metadata_set( 114 | package, 115 | "revdepcheckversion", 116 | getNamespaceVersion("revdepcheck")[[1]] 117 | ) 118 | 119 | if (package != ":memory:") { 120 | db_metadata_set(package, "package", pkg_name(package)) 121 | } 122 | } 123 | 124 | #' @importFrom DBI dbExecute sqlInterpolate 125 | 126 | db_metadata_set <- function(package, name, value) { 127 | db <- db(package) 128 | 129 | dbWithTransaction(db, { 130 | sql <- sqlInterpolate( 131 | db, 132 | "DELETE FROM metadata WHERE name = ?name", 133 | name = name 134 | ) 135 | dbExecute(db, sql) 136 | 137 | sql <- sqlInterpolate( 138 | db, 139 | "INSERT INTO metadata VALUES (?name, ?value)", 140 | name = name, 141 | value = value 142 | ) 143 | dbExecute(db, sql) 144 | }) 145 | } 146 | 147 | #' @importFrom DBI dbGetQuery sqlInterpolate 148 | 149 | db_metadata_get <- function(package, name) { 150 | db <- db(package) 151 | sql <- sqlInterpolate( 152 | db, 153 | "SELECT value FROM metadata WHERE name = ?name", 154 | name = name 155 | ) 156 | dbGetQuery(db, sql)[[1]] 157 | } 158 | 159 | #' @importFrom DBI dbExecute 160 | 161 | db_clean <- function(package) { 162 | ## Do not use the cache, might be from an old run 163 | db_disconnect(package) 164 | 165 | dbExecute(db(package), "DELETE FROM revdeps") 166 | dbExecute(db(package), "DELETE FROM metadata") 167 | db_metadata_init(package) 168 | 169 | ## Remove the cache 170 | db_disconnect(package) 171 | } 172 | 173 | #' @importFrom DBI dbGetQuery 174 | #' @importFrom RSQLite dbExistsTable 175 | 176 | db_exists <- function(package) { 177 | if (!file.exists(dir_find(package, "db"))) { 178 | return(FALSE) 179 | } 180 | if (!dbExistsTable(db(package), "revdeps")) { 181 | return(FALSE) 182 | } 183 | 184 | TRUE 185 | } 186 | 187 | db_list <- function(package) { 188 | if (!db_exists(package)) { 189 | return(character()) 190 | } 191 | pkgs <- dbGetQuery( 192 | db(package), 193 | "SELECT DISTINCT package, which FROM revdeps" 194 | ) 195 | 196 | ## Check if both the old and new run is done 197 | package_names <- unique(pkgs$package) 198 | Filter( 199 | function(p) sum(pkgs$package == p) == 2, 200 | package_names 201 | ) 202 | } 203 | 204 | #' @importFrom DBI dbGetQuery 205 | 206 | db_todo <- function(pkgdir) { 207 | db <- db(pkgdir) 208 | 209 | dbGetQuery(db, "SELECT package FROM todo WHERE status = 'todo'")[[1]] 210 | } 211 | 212 | db_todo_status_internal <- function(db) { 213 | dbReadTable(db, "todo") 214 | } 215 | 216 | db_todo_status <- function(pkgdir) { 217 | db <- db(pkgdir) 218 | db_todo_status_internal(db) 219 | } 220 | 221 | #' @importFrom DBI dbWithTransaction dbReadTable dbWriteTable 222 | 223 | db_todo_add_internal <- function(db, packages, silent = TRUE) { 224 | if (!silent) { 225 | message( 226 | "Adding packages to TODO list: \n", 227 | paste("*", packages, "\n", collapse = ""), 228 | "\n", 229 | "Run revdepcheck::revdep_check() to check" 230 | ) 231 | } 232 | todo <- dbReadTable(db, "todo") 233 | todo$status[todo$package %in% packages] <- "todo" 234 | new <- setdiff(packages, todo$package) 235 | if (length(new)) { 236 | newdf <- data.frame( 237 | package = new, 238 | status = "todo", 239 | stringsAsFactors = FALSE 240 | ) 241 | todo <- rbind(todo, newdf) 242 | } 243 | dbWriteTable(db, "todo", todo, overwrite = TRUE) 244 | } 245 | 246 | db_todo_add <- function(pkgdir, packages, silent = TRUE) { 247 | db <- db(pkgdir) 248 | dbWithTransaction(db, db_todo_add_internal(db, packages, silent)) 249 | invisible(pkgdir) 250 | } 251 | 252 | db_todo_add_new <- function(pkgdir, revdeps, silent) { 253 | db <- db(pkgdir) 254 | dbWithTransaction(db, { 255 | intodo <- db_todo_status_internal(db)$package 256 | donever <- dbGetQuery( 257 | db, 258 | "SELECT r.package, r.version FROM todo t, revdeps r 259 | WHERE r.package = t.package AND t.status = 'done' AND 260 | r.which = 'new'" 261 | ) 262 | 263 | ## Need to add packages that are not in the todo table at all 264 | to_add <- setdiff(revdeps$package, intodo) 265 | 266 | ## Need to re-add packages that are there and that are done already, 267 | ## but they have new releases 268 | cmn <- intersect(donever$package, revdeps$package) 269 | oldver <- donever$version[match(cmn, donever$package)] 270 | newver <- revdeps$version[match(cmn, revdeps$package)] 271 | to_add <- c(to_add, cmn[oldver != newver]) 272 | 273 | if (length(to_add)) db_todo_add_internal(db, to_add, silent) 274 | }) 275 | 276 | to_add 277 | } 278 | 279 | #' @importFrom DBI dbReadTable 280 | 281 | db_todo_rm <- function(pkgdir, packages) { 282 | db <- db(pkgdir) 283 | 284 | dbWithTransaction( 285 | db, 286 | { 287 | todo <- dbReadTable(db, "todo") 288 | todo$status[todo$package %in% packages] <- "ignore" 289 | miss <- setdiff(packages, todo$package) 290 | if (length(miss)) { 291 | warning("Unknown package(s): ", paste(miss, collapse = ", ")) 292 | } 293 | dbWriteTable(db, "todo", todo, overwrite = TRUE) 294 | } 295 | ) 296 | 297 | invisible(pkgdir) 298 | } 299 | 300 | #' @importFrom DBI dbExecute sqlInterpolate 301 | 302 | db_insert <- function( 303 | pkgdir, 304 | package, 305 | version = NULL, 306 | maintainer = NULL, 307 | status, 308 | which = c("old", "new"), 309 | duration, 310 | starttime, 311 | result, 312 | summary 313 | ) { 314 | which <- match.arg(which) 315 | 316 | db <- db(pkgdir) 317 | 318 | ## To avoid duplicate records in the DB 319 | dbExecute( 320 | db, 321 | sqlInterpolate( 322 | db, 323 | "DELETE FROM revdeps WHERE package = ?package AND which = ?which", 324 | package = package, 325 | which = which 326 | ) 327 | ) 328 | ## If both checks are done then we set the status to 'done' 329 | ## If only one of them is done, then we don't do this, so 330 | ## both checks are re-run if the checks are interrupted half-way 331 | dbWithTransaction( 332 | db, 333 | { 334 | q <- "SELECT which FROM revdeps WHERE package = ?package AND which <> ?which" 335 | done <- dbGetQuery( 336 | db, 337 | sqlInterpolate(db, q, package = package, which = which) 338 | ) 339 | if (nrow(done)) { 340 | dbExecute( 341 | db, 342 | sqlInterpolate( 343 | db, 344 | "UPDATE todo SET status='done' WHERE package = ?package", 345 | package = package 346 | ) 347 | ) 348 | } 349 | } 350 | ) 351 | 352 | q <- "INSERT INTO revdeps 353 | (package, version, maintainer, status, which, duration, 354 | starttime, result, summary) VALUES 355 | (?package, ?version, ?maintainer, ?status, ?which, ?duration, 356 | ?starttime, ?result, ?summary)" 357 | 358 | ## TODO: better way to get version, maintainer, so they are never NULL 359 | dbExecute( 360 | db, 361 | sqlInterpolate( 362 | db, 363 | q, 364 | package = package, 365 | version = version %|0|% "", 366 | maintainer = maintainer %|0|% "", 367 | status = status, 368 | which = which, 369 | duration = duration, 370 | starttime = as.character(starttime), 371 | result = result, 372 | summary = summary %|0|% "" 373 | ) 374 | ) 375 | } 376 | 377 | filter_result_pkgs <- function(res, revdeps) { 378 | if (!is.null(revdeps)) { 379 | res <- res[res$package %in% revdeps, ] 380 | if (any(miss <- !revdeps %in% res$package)) { 381 | warning( 382 | "No results for packages: ", 383 | paste(sQuote(revdeps[miss]), collapse = ", ") 384 | ) 385 | } 386 | } 387 | res 388 | } 389 | 390 | db_get_results <- function(pkg, revdeps) { 391 | db <- db(pkg) 392 | 393 | if (is.null(revdeps)) { 394 | old <- dbGetQuery( 395 | db, 396 | "SELECT * FROM revdeps WHERE which = 'old' 397 | ORDER BY package COLLATE NOCASE" 398 | ) 399 | new <- dbGetQuery( 400 | db, 401 | "SELECT * FROM revdeps WHERE which = 'new' 402 | ORDER BY package COLLATE NOCASE" 403 | ) 404 | } else { 405 | revdepstr <- paste0("(", paste0('"', revdeps, '"', collapse = ","), ")") 406 | old <- dbGetQuery( 407 | db, 408 | paste0( 409 | "SELECT * FROM revdeps 410 | WHERE which = 'old' AND package IN ", 411 | revdepstr, 412 | "ORDER BY package COLLATE NOCASE" 413 | ) 414 | ) 415 | new <- dbGetQuery( 416 | db, 417 | paste0( 418 | "SELECT * FROM revdeps 419 | WHERE which = 'new' AND package IN ", 420 | revdepstr, 421 | "ORDER BY package COLLATE NOCASE" 422 | ) 423 | ) 424 | } 425 | 426 | list(old = old, new = new) 427 | } 428 | 429 | db_results <- function(pkg, revdeps) { 430 | res <- db_get_results(pkg, revdeps) 431 | 432 | packages <- union(res$old$package, res$new$package) 433 | 434 | lapply_with_names(packages, function(package) { 435 | oldcheck <- checkFromJSON(res$old$result[match(package, res$old$package)]) 436 | newcheck <- checkFromJSON(res$new$result[match(package, res$new$package)]) 437 | 438 | try_compare_checks(package, oldcheck, newcheck) 439 | }) 440 | } 441 | 442 | db_maintainers <- function(pkg) { 443 | res <- dbGetQuery(db(pkg), "SELECT DISTINCT maintainer, package FROM revdeps") 444 | set_names(res$maintainer, res$package) 445 | } 446 | -------------------------------------------------------------------------------- /R/report.R: -------------------------------------------------------------------------------- 1 | #' Markdown report of reverse dependency check results 2 | #' 3 | #' You can use these functions to get intermediate reports of a [revdep_check()] 4 | #' running in another session. 5 | #' 6 | #' `revdep_report_summary()` writes the contents of `README.md`, by 7 | #' default to the console. This is handy to quickly inspect the (current) 8 | #' list of problematic packages. 9 | #' 10 | #' @inheritParams revdep_check 11 | #' @param file File to write output to. Default will write to console. 12 | #' @param all Whether to report all problems, including the ones that 13 | #' were already present in the old version of the package. This potentially 14 | #' generated a lot of output, most of which was irrelevant, so they are 15 | #' omitted by default, and only problems seen with the new version of 16 | #' the package are reported. 17 | #' @param results Cached results from `db_results()`. Expert use only. 18 | #' @export 19 | #' @importFrom crayon black red yellow green 20 | #' @importFrom sessioninfo platform_info 21 | 22 | revdep_report_summary <- function( 23 | pkg = ".", 24 | file = "", 25 | all = FALSE, 26 | results = NULL 27 | ) { 28 | pkg <- pkg_check(pkg) 29 | if (is_string(file) && !identical(file, "")) { 30 | file <- file(file, encoding = "UTF-8", open = "w") 31 | on.exit(close(file), add = TRUE) 32 | 33 | opts <- options("crayon.enabled" = FALSE) 34 | on.exit(options(opts), add = TRUE) 35 | } 36 | 37 | cat_header("Platform", file = file) 38 | cat_kable(report_platform(), file = file) 39 | 40 | cat_header("Dependencies", file = file) 41 | cat_kable(report_libraries(pkg), file = file) 42 | 43 | cat_header("Revdeps", file = file) 44 | revdeps <- report_revdeps(pkg, all = all, results = results) 45 | 46 | status <- revdeps$status 47 | n_issues <- revdeps$issues 48 | revdeps$status <- revdeps$issues <- NULL 49 | failed <- !(status %in% c("+", "-")) 50 | broken <- status == "-" 51 | if (!all) { 52 | broken <- broken & n_issues > 0 53 | } 54 | 55 | revdep_report_section("Failed to check", revdeps[failed, ], file = file) 56 | revdep_report_section("New problems", revdeps[broken, ], file = file) 57 | if (all) { 58 | revdep_report_section("All", revdeps, file = file) 59 | } 60 | 61 | invisible() 62 | } 63 | 64 | revdep_report_section <- function(title, rows, file) { 65 | if (NROW(rows) == 0) { 66 | return() 67 | } 68 | 69 | cat_header(title, " (", nrow(rows), ")", level = 2, file = file) 70 | cat_kable(rows, file = file) 71 | } 72 | 73 | #' `revdep_report_problems()` generates a report about packages with check 74 | #' problems. 75 | #' 76 | #' @export 77 | #' @rdname revdep_report_summary 78 | 79 | revdep_report_problems <- function( 80 | pkg = ".", 81 | file = "", 82 | all = FALSE, 83 | results = NULL, 84 | bioc = TRUE, 85 | cran = TRUE 86 | ) { 87 | ## We show the packages that 88 | ## 1. are newly broken 89 | ## 2. still broken, if all == TRUE 90 | problem <- function(x) { 91 | any(x$cmp$change == 1) || (all && any(x$cmp$change == 0)) 92 | } 93 | revdep_report_if( 94 | pkg = pkg, 95 | file = file, 96 | predicate = problem, 97 | results = results, 98 | bioc = bioc, 99 | cran = cran 100 | ) 101 | } 102 | 103 | #' `revdep_report_failures()` generates a report about packages that failed 104 | #' to check (i.e. couldn't install, or timed out). 105 | #' 106 | #' @export 107 | #' @rdname revdep_report_summary 108 | 109 | revdep_report_failures <- function( 110 | pkg = ".", 111 | file = "", 112 | results = NULL, 113 | bioc = TRUE, 114 | cran = TRUE 115 | ) { 116 | problem <- function(x) { 117 | !x$status %in% c("+", "-") 118 | } 119 | revdep_report_if( 120 | pkg = pkg, 121 | file = file, 122 | predicate = problem, 123 | results = results, 124 | bioc = bioc, 125 | cran = cran 126 | ) 127 | } 128 | 129 | revdep_report_if <- function( 130 | pkg = ".", 131 | file = "", 132 | predicate, 133 | results = NULL, 134 | bioc = TRUE, 135 | cran = TRUE 136 | ) { 137 | if (is_string(file) && !identical(file, "")) { 138 | file <- file(file, encoding = "UTF-8", open = "w") 139 | on.exit(close(file), add = TRUE) 140 | 141 | opts <- options("crayon.enabled" = FALSE) 142 | on.exit(options(opts), add = TRUE) 143 | } 144 | 145 | results <- results %||% db_results(pkg, NULL) 146 | show <- map_lgl(results, predicate) 147 | 148 | if (sum(show)) { 149 | map(results[show], failure_details, file = file, bioc = bioc, cran = cran) 150 | } else { 151 | cat("*Wow, no problems at all. :)*", file = file) 152 | } 153 | 154 | invisible() 155 | } 156 | 157 | failure_details <- function(x, file = "", bioc = TRUE, cran = TRUE) { 158 | cat_header(x$package, " (", x$new$version, ")", level = 1, file = file) 159 | cat_package_info(x, file = file, bioc = bioc, cran = cran) 160 | cat_line(file = file) 161 | 162 | if (x$status == "E") { 163 | cat_header("Error before installation", level = 2, file = file) 164 | cat_header("Devel", level = 3, file = file) 165 | cat_line("```", file = file) 166 | cat_line(line_trunc(x$new$stdout), sep = "\n", file = file) 167 | cat_line(line_trunc(x$new$stderr), sep = "\n", file = file) 168 | cat_line("```", file = file) 169 | cat_header("CRAN", level = 3, file = file) 170 | cat_line("```", file = file) 171 | cat_line(line_trunc(x$old$stdout), sep = "\n", file = file) 172 | cat_line(line_trunc(x$old$stderr), sep = "\n", file = file) 173 | cat_line("```", file = file) 174 | } else { 175 | rows <- x$cmp 176 | cat_failure_section("Newly broken", rows[rows$change == +1, ], file = file) 177 | cat_failure_section("Newly fixed", rows[rows$change == -1, ], file = file) 178 | cat_failure_section("In both", rows[rows$change == 0, ], file = file) 179 | 180 | if (x$status %in% c("i-", "i+")) { 181 | cat_header("Installation", level = 2, file = file) 182 | cat_header("Devel", level = 3, file = file) 183 | cat_line("```", file = file) 184 | cat_line(line_trunc(x$new$install_out), sep = "\n", file = file) 185 | cat_line("```", file = file) 186 | cat_header("CRAN", level = 3, file = file) 187 | cat_line("```", file = file) 188 | cat_line(line_trunc(x$old[[1]]$install_out), sep = "\n", file = file) 189 | cat_line("```", file = file) 190 | } 191 | } 192 | 193 | invisible() 194 | } 195 | 196 | cat_package_info <- function(cmp, file, bioc = TRUE, cran = TRUE) { 197 | links <- pkg_links(cmp) 198 | cat_line( 199 | paste0("* ", names(links), ": <", links, ">\n", collapse = ""), 200 | file = file 201 | ) 202 | 203 | type <- cmp$new$type %||% "revdep" 204 | cat_glue( 205 | 'Run `revdepcheck::{type}_details(, "{cmp$package}")` for more info', 206 | file = file 207 | ) 208 | } 209 | 210 | num_deps <- function(pkg, bioc = TRUE, cran = TRUE) { 211 | repos <- get_repos(bioc = bioc, cran = cran) 212 | length(cran_deps(pkg, repos)) 213 | } 214 | 215 | pkg_github <- function(desc) { 216 | urls <- c( 217 | desc$get_field("BugReports", default = character()), 218 | desc$get_urls() 219 | ) 220 | gh_links <- grep("^https?://github.com/", urls, value = TRUE) 221 | 222 | if (length(gh_links) == 0) { 223 | NULL 224 | } else { 225 | re <- paste0( 226 | "^", 227 | "(?:https?://github.com/)", 228 | "(?[^/]+)/", 229 | "(?[^/#]+)", 230 | "/?", 231 | "(?.*)", 232 | "$" 233 | ) 234 | 235 | remote <- rematch2::re_match(gh_links[[1]], re) 236 | paste0("https://github.com/", remote$owner, "/", remote$repo) 237 | } 238 | } 239 | 240 | wrap_tag <- function(tag, txt) { 241 | txt <- paste0(txt, collapse = "\n") 242 | paste0("<", tag, ">\n\n", txt, "\n\n\n") 243 | } 244 | 245 | normalize_space <- function(x) { 246 | gsub("\\s+", " ", x) 247 | } 248 | 249 | cat_failure_section <- function(title, rows, file) { 250 | if (NROW(rows) == 0) { 251 | return() 252 | } 253 | 254 | cat_header(title, level = 2, file = file) 255 | cat(format_details_bullets(rows$output), sep = "", file = file) 256 | } 257 | 258 | format_details_bullets <- function(x, max_lines = 25) { 259 | map_chr(x, format_details_bullet, max_lines = max_lines) 260 | } 261 | 262 | format_details_bullet <- function(x, max_lines = 30) { 263 | lines <- strsplit(x, "\n")[[1]] 264 | 265 | title <- trimws(lines[[1]]) 266 | 267 | details <- lines[-1] 268 | n <- length(details) 269 | # We don't use trunc_lines() here because the start of the test is usually 270 | # least interesting, and that's the primary case where we need to truncate 271 | if (n > max_lines) { 272 | details <- c("...", details[(n - max_lines + 1):n]) 273 | } 274 | if (n > 0) { 275 | details <- c("```", details, "```") 276 | details <- paste(strrep(" ", 4), details) 277 | } 278 | details <- paste0(details, "\n", collapse = "") 279 | 280 | paste0("* ", red(title), "\n", details, "\n") 281 | } 282 | 283 | #' `revdep_report_cran()` prints a short summary of the reverse dependency 284 | #' checks, that is suitable for a CRAN submission. 285 | #' 286 | #' @export 287 | #' @rdname revdep_report_summary 288 | #' @importFrom utils available.packages 289 | 290 | revdep_report_cran <- function(pkg = ".", file = "", results = NULL) { 291 | opts <- options("crayon.enabled" = FALSE) 292 | on.exit(options(opts), add = TRUE) 293 | 294 | if (is_string(file) && !identical(file, "")) { 295 | file <- file(file, encoding = "UTF-8", open = "w") 296 | on.exit(close(file), add = TRUE) 297 | } 298 | 299 | results <- results %||% db_results(pkg, NULL) 300 | 301 | status <- map_chr(results, function(x) x$status %|0|% "i-") 302 | package <- map_chr(results, "[[", "package") 303 | on_cran <- map_lgl(results, on_cran) 304 | 305 | broke <- status == "-" & on_cran 306 | failed <- !(status %in% c("+", "-")) & on_cran 307 | 308 | cat_line("## revdepcheck results", file = file) 309 | cat_line(file = file) 310 | cat_line( 311 | "We checked ", 312 | length(results), 313 | " reverse dependencies", 314 | if (any(!on_cran)) { 315 | paste0( 316 | " (", 317 | sum(on_cran), 318 | " from CRAN + ", 319 | sum(!on_cran), 320 | " from Bioconductor)" 321 | ) 322 | }, 323 | ", comparing R CMD check results across CRAN and dev versions of this package.", 324 | file = file 325 | ) 326 | cat_line(file = file) 327 | cat_line(" * We saw ", sum(broke), " new problems", file = file) 328 | cat_line(" * We failed to check ", sum(failed), " packages", file = file) 329 | if (any(broke | failed)) { 330 | cat_line(file = file) 331 | cat_line("Issues with CRAN packages are summarised below.", file = file) 332 | } 333 | cat_line(file = file) 334 | 335 | if (any(broke)) { 336 | cat_line("### New problems", file = file) 337 | cat_line("(This reports the first line of each new failure)", file = file) 338 | cat_line(file = file) 339 | 340 | issues <- map(results[broke], "[[", "cmp") 341 | new <- map(issues, function(x) x$output[x$change == 1]) 342 | first_line <- map(new, function(x) map_chr(strsplit(x, "\n"), "[[", 1)) 343 | collapsed <- map_chr(first_line, function(x) { 344 | paste0(" ", x, "\n", collapse = "") 345 | }) 346 | 347 | cat( 348 | paste0("* ", package[broke], "\n", collapsed, "\n", collapse = ""), 349 | file = file 350 | ) 351 | } 352 | 353 | if (any(failed)) { 354 | cat_line("### Failed to check", file = file) 355 | cat_line(file = file) 356 | desc <- unname(c(i = "failed to install", t = "check timed out")[status]) 357 | cat( 358 | paste0("* ", format(package[failed]), " (", desc[failed], ")\n"), 359 | sep = "", 360 | file = file 361 | ) 362 | } 363 | 364 | invisible() 365 | } 366 | 367 | on_cran <- function(x) { 368 | isTRUE(x$new$cran) 369 | } 370 | 371 | #' `revdep_report()` writes `README.md`, `problems.md`, `failures.md`, and 372 | #' `cran.md`. This is normally done automatically when the checks are complete, 373 | #' but you can also do it when checks are in progress to get a partial report. 374 | #' 375 | #' @export 376 | #' @rdname revdep_report_summary 377 | 378 | revdep_report <- function( 379 | pkg = ".", 380 | all = FALSE, 381 | results = NULL, 382 | bioc = TRUE, 383 | cran = TRUE 384 | ) { 385 | pkg <- pkg_check(pkg) 386 | root <- dir_find(pkg, "root") 387 | 388 | # Open file here because we might write a partial note before 389 | # calling `revdep_report_summary()` 390 | readme_path <- file.path(root, "README.md") 391 | readme_file <- file(readme_path, encoding = "UTF-8", open = "w") 392 | on.exit(close(readme_file), add = TRUE) 393 | 394 | opts <- options("crayon.enabled" = FALSE) 395 | on.exit(options(opts), add = TRUE) 396 | 397 | if (!identical(db_metadata_get(pkg, "todo"), "done")) { 398 | message("Writing *partial* report") 399 | cat("These are *partial* results!\n\n", file = readme_file) 400 | } 401 | 402 | results <- results %||% db_results(pkg, NULL) 403 | 404 | message("Writing summary to 'revdep/README.md'") 405 | revdep_report_summary(pkg, file = readme_file, all = all, results = results) 406 | 407 | message("Writing problems to 'revdep/problems.md'") 408 | revdep_report_problems( 409 | pkg, 410 | file = file.path(root, "problems.md"), 411 | all = all, 412 | results = results, 413 | bioc = bioc, 414 | cran = cran 415 | ) 416 | 417 | message("Writing failures to 'revdep/failures.md'") 418 | revdep_report_failures( 419 | pkg, 420 | file = file.path(root, "failures.md"), 421 | results = results, 422 | bioc = bioc, 423 | cran = cran 424 | ) 425 | 426 | message("Writing CRAN report to 'revdep/cran.md'") 427 | revdep_report_cran(pkg, file = file.path(root, "cran.md"), results = results) 428 | 429 | invisible() 430 | } 431 | 432 | # Helpers ----------------------------------------------------------------- 433 | 434 | report_platform <- function() { 435 | platform <- platform_info() 436 | data.frame(field = names(platform), value = unlist(platform)) 437 | } 438 | 439 | report_libraries <- function(pkg) { 440 | path <- file.path(dir_find(pkg, "checks"), "libraries.csv") 441 | 442 | df <- utils::read.csv(path, stringsAsFactors = FALSE) 443 | names(df)[4] <- "\u0394" 444 | 445 | df 446 | } 447 | 448 | report_status <- function(pkg = ".") { 449 | packages <- db_results(pkg, NULL) 450 | broken <- map_lgl(packages, is_broken) 451 | 452 | list( 453 | todo = length(db_todo(pkg)), 454 | ok = sum(!broken), 455 | broken = sum(broken) 456 | ) 457 | } 458 | 459 | report_revdeps <- function(pkg = ".", all = FALSE, results = NULL) { 460 | results <- results %||% db_results(pkg, NULL) 461 | 462 | make_summary <- function(x, type) { 463 | rows <- x$cmp[x$cmp$type == type, , drop = FALSE] 464 | 465 | both <- sum(rows$change == 0) 466 | fixed <- sum(rows$change == -1) 467 | broke <- sum(rows$change == 1) 468 | 469 | paste0( 470 | if (both) both else "", 471 | if (fixed) paste0(" -", fixed), 472 | if (broke) paste0(" __+", broke, "__") 473 | ) 474 | } 475 | 476 | problem_link <- function(pkg, status) { 477 | path <- ifelse(!status %in% c("+", "-"), "failures.md", "problems.md") 478 | slug <- gsub("[.]", "", tolower(pkg)) 479 | paste0("[", pkg, "](", path, "#", slug, ")") 480 | } 481 | 482 | md_link <- function(pkg, lnk) { 483 | paste0("[", pkg, "](", lnk, ")") 484 | } 485 | 486 | if (all) { 487 | n_issues <- map_int(results, function(x) sum(x$cmp$change %in% c(0, 1))) 488 | } else { 489 | n_issues <- map_int(results, function(x) sum(x$cmp$change == 1)) 490 | } 491 | 492 | status <- map_chr(results, rcmdcheck_status) 493 | pkgname <- map_chr(results, "[[", "package") 494 | 495 | data.frame( 496 | status = status, 497 | issues = n_issues, 498 | package = ifelse(n_issues > 0, problem_link(pkgname, status), pkgname), 499 | version = map_chr(results, rcmdcheck_version), 500 | error = map_chr(results, make_summary, "error"), 501 | warning = map_chr(results, make_summary, "warning"), 502 | note = map_chr(results, make_summary, "note"), 503 | stringsAsFactors = FALSE, 504 | check.names = FALSE 505 | ) 506 | } 507 | 508 | # Styling ----------------------------------------------------------------- 509 | 510 | #' @importFrom knitr kable 511 | #' @importFrom crayon bold 512 | 513 | cat_line <- function(..., file = "", sep = "") { 514 | cat(..., "\n", sep = sep, file = file) 515 | } 516 | 517 | cat_glue <- function(msg, envir = parent.frame(), file = "", sep = "") { 518 | msg <- glue::glue(msg, .envir = envir) 519 | cat(msg, "\n", sep = sep, file = file) 520 | } 521 | 522 | 523 | cat_rule <- function(..., file = "") { 524 | cat_line(rule(...), file = file) 525 | } 526 | 527 | cat_kable <- function(x, ..., file = "") { 528 | cat(kable(x, row.names = FALSE), sep = "\n", file = file) 529 | cat_line(file = file) 530 | } 531 | 532 | cat_header <- function(..., level = 1, file = "") { 533 | cat(bold(paste0(strrep("#", level), " ", ...)), "\n", sep = "", file = file) 534 | cat_line(file = file) 535 | } 536 | 537 | cat_bullet <- function(..., file = "") { 538 | cat_line("* ", ..., file = file) 539 | } 540 | 541 | cat_print <- function(x, file = "") { 542 | if (!identical(file, "")) { 543 | sink(file) 544 | on.exit(sink(NULL)) 545 | } 546 | 547 | print(x) 548 | } 549 | -------------------------------------------------------------------------------- /R/cloud.R: -------------------------------------------------------------------------------- 1 | #' Monitor the status of a cloud job 2 | #' 3 | #' The format of the status bar is 4 | #' `[jobs_queued/jobs_running/jobs_succeeded/jobs_failed - total_jobs] time_elapsed | ETA: estimate_time_remaining` 5 | #' 6 | #' @param update_interval The number of seconds between querying for updates 7 | #' @family cloud 8 | #' @importFrom cli cli_format cli_status_update col_green col_blue col_red 9 | #' style_bold cli_status_clear cli_status cli_alert 10 | #' @inheritParams cloud_report 11 | #' @export 12 | cloud_status <- function(job_name = cloud_job(), update_interval = 10) { 13 | status_id <- cli_status("Status of {.val {job_name}}") 14 | 15 | info <- cloud_job_info(job_name) 16 | 17 | started_time <- as.POSIXct( 18 | info$started_timestamp, 19 | tz = "UTC", 20 | format = "%Y-%m-%dT%H:%M:%OS" 21 | ) 22 | 23 | cloud_status_check <- function(job_name) { 24 | status <- cloud_job_status(job_name) 25 | 26 | if (length(status) == 0) { 27 | stop("No job with name: '", job_name, call. = FALSE) 28 | } 29 | 30 | size <- status$size 31 | results <- unlist(status$statusSummary) 32 | 33 | if (!is.integer(results)) { 34 | return(NA) 35 | } 36 | 37 | names(results) <- tolower(names(results)) 38 | results <- results[c( 39 | "pending", 40 | "runnable", 41 | "starting", 42 | "running", 43 | "succeeded", 44 | "failed" 45 | )] 46 | 47 | num_completed <- sum(results[c("succeeded", "failed")]) 48 | num_queued <- sum(results[c("pending", "runnable")]) 49 | num_running <- sum(results[c("starting", "running")]) 50 | 51 | current_time <- Sys.time() 52 | 53 | elapsed <- hms::as_hms(as.integer(difftime( 54 | current_time, 55 | started_time, 56 | units = "secs" 57 | ))) 58 | 59 | status_bar_text <- "[{num_queued}/{col_blue(num_running)}/{col_green(results[['succeeded']])}/{col_red(results[['failed']])} - {.strong {size}}] {elapsed}" 60 | 61 | if (results[["failed"]] > 0) { 62 | cli_status_clear( 63 | id = status_id, 64 | result = "failed", 65 | msg_failed = paste0("{.emph FAILED}: ", status_bar_text) 66 | ) 67 | cli_alert( 68 | "run {.run revdepcheck::cloud_summary()} for interactive results" 69 | ) 70 | cli_alert("run {.run revdepcheck::cloud_report()} for markdown reports") 71 | return(FALSE) 72 | } 73 | 74 | if (num_completed == length(info$revdep_packages)) { 75 | cli_status_clear( 76 | id = status_id, 77 | result = "done", 78 | msg_done = paste0("{.emph SUCCEEDED}: ", status_bar_text) 79 | ) 80 | cli_alert( 81 | "run {.run revdepcheck::cloud_summary()} for interactive results" 82 | ) 83 | cli_alert("run {.run revdepcheck::cloud_report()} for markdown reports") 84 | return(TRUE) 85 | } 86 | 87 | cli::cli_status_update(id = status_id, status_bar_text) 88 | return(NA) 89 | } 90 | 91 | while (is.na(res <- cloud_status_check(job_name))) { 92 | Sys.sleep(update_interval) 93 | } 94 | 95 | return(invisible(res)) 96 | } 97 | 98 | #' Fetch results from the cloud 99 | #' 100 | #' Intended mainly for internal and expert use. This function when needed by 101 | #' [cloud_report()] and [cloud_summary()], so it is unlikely you will need to 102 | #' call it explicitly. 103 | #' 104 | #' @keywords internal 105 | #' @family cloud 106 | #' @inheritParams cloud_report 107 | #' @importFrom curl new_handle handle_setheaders new_pool multi_add multi_run handle_setopt 108 | #' @importFrom cli cli_progress_bar cli_progress_update cli_progress_done pb_percent 109 | #' @export 110 | cloud_fetch_results <- function(job_name = cloud_job(pkg = pkg), pkg = ".") { 111 | pkg <- pkg_check(pkg) 112 | cloud <- dir_find(pkg, "cloud") 113 | 114 | info <- cloud_job_info(job_name) 115 | 116 | out_dir <- file.path(cloud, job_name) 117 | 118 | dir.create(out_dir, showWarnings = FALSE, recursive = TRUE, mode = "0744") 119 | 120 | rel_out_dir <- sub(paste0(pkg_check(pkg), "/"), "", out_dir, fixed = TRUE) 121 | cli_alert_info("Syncing results to {.file {rel_out_dir}}") 122 | 123 | packages <- info$revdep_packages 124 | 125 | out_files <- file.path(out_dir, paste0(packages, ".tar.gz")) 126 | 127 | to_download <- !file.exists(out_files) 128 | 129 | pb <- cli_progress_bar( 130 | format = "Downloading package results: {pb_percent}", 131 | total = sum(to_download) 132 | ) 133 | handle_success <- function(res) { 134 | if (res$status_code >= 400) { 135 | out_file <- sprintf("%s/%s.tar.gz", out_dir, basename(dirname(res$url))) 136 | unlink(out_file) 137 | } 138 | cli_progress_update(id = pb) 139 | } 140 | pool <- new_pool() 141 | for (i in which(to_download)) { 142 | out_file <- out_files[[i]] 143 | package <- packages[[i]] 144 | url <- sprintf( 145 | "https://xgyefaepu5.execute-api.us-east-1.amazonaws.com/staging/check/%s/packages/%s/results.tar.gz", 146 | job_name, 147 | package 148 | ) 149 | 150 | handle <- new_handle() 151 | handle_setopt(handle, url = enc2utf8(url)) 152 | handle_setheaders( 153 | handle, 154 | "x-api-key" = Sys.getenv("RSTUDIO_CLOUD_REVDEP_KEY"), 155 | Accept = "application/x-gzip" 156 | ) 157 | multi_add( 158 | handle = handle, 159 | done = handle_success, 160 | pool = pool, 161 | data = out_file 162 | ) 163 | } 164 | out <- multi_run(pool = pool) 165 | cli_progress_done(id = pb) 166 | 167 | to_extract <- file.exists(out_files) & 168 | !dir.exists(file.path(out_dir, packages)) 169 | 170 | pb2 <- cli_progress_bar( 171 | format = "Extracting package results: {pb_percent}", 172 | total = sum(to_extract) 173 | ) 174 | for (i in which(to_extract)) { 175 | out_file <- out_files[[i]] 176 | utils::untar(out_file, exdir = out_dir) 177 | cli_progress_update(id = pb2) 178 | } 179 | cli_progress_done(id = pb2) 180 | } 181 | 182 | #' Submit a reverse dependency checking job to the cloud 183 | #' 184 | #' @param tarball A pre-built package tarball, if `NULL` a tarball will be 185 | #' automatically built for the package at `pkg` by [pkgbuild::build()]. 186 | #' @param revdep_packages A character vector of packages to check, if `NULL` 187 | #' equal to [cran_revdeps()] 188 | #' @param r_version The R version to use. 189 | #' @param check_args Additional argument to pass to `R CMD check` 190 | #' @param extra_revdeps Additional packages to use as source for reverse 191 | #' dependencies. 192 | #' @param bioc Also check revdeps that live in Bioconductor? Default `FALSE`. 193 | #' Note that the cloud revdep check service does not currently include system 194 | #' dependencies of Bioconductor packages, so there is potential for more 195 | #' failed checks. 196 | #' @returns The AWS Batch job name 197 | #' @inheritParams revdep_check 198 | #' @importFrom cli cli_alert_info cli_alert_success cli_alert_danger 199 | #' @importFrom httr GET PATCH POST stop_for_status add_headers content 200 | #' @family cloud 201 | #' @export 202 | cloud_check <- function( 203 | pkg = ".", 204 | tarball = NULL, 205 | revdep_packages = NULL, 206 | extra_revdeps = NULL, 207 | r_version = "4.5.1", 208 | check_args = "--no-manual", 209 | bioc = FALSE 210 | ) { 211 | if (is.null(tarball)) { 212 | cli::cli_alert_info("Building package tarball") 213 | pkg <- pkg_check(pkg) 214 | tarball <- pkgbuild::build(path = pkg, quiet = TRUE) 215 | } 216 | 217 | package_name <- desc::desc_get_field("Package", file = tarball) 218 | package_version <- as.character(desc::desc_get_version(file = tarball)) 219 | 220 | # Lookup revdeps with R, as the RSPM db seems not quite right, for instance 221 | # it seems to include archived packages. 222 | if (is.null(revdep_packages)) { 223 | revdep_packages <- setdiff( 224 | cran_revdeps(c(package_name, extra_revdeps), bioc = bioc), 225 | package_name 226 | ) 227 | } 228 | 229 | if (length(revdep_packages) == 1) { 230 | stop( 231 | "`revdepcheck::cloud_check()` can't work with exactly 1 revdep package (AWS batch jobs must have more than one job)", 232 | call. = FALSE 233 | ) 234 | } 235 | 236 | post_response <- POST( 237 | "https://xgyefaepu5.execute-api.us-east-1.amazonaws.com/staging/check", 238 | config = add_headers("x-api-key" = Sys.getenv("RSTUDIO_CLOUD_REVDEP_KEY")), 239 | body = list( 240 | package_name = package_name, 241 | package_version = package_version, 242 | revdep_packages = revdep_packages, 243 | r_version = r_version, 244 | check_args = check_args 245 | ), 246 | encode = "json" 247 | ) 248 | 249 | cloud_stop_for_status(post_response) 250 | 251 | post_content <- content(post_response) 252 | presigned_url <- post_content[["_source_presigned_url"]] 253 | job_name <- post_content[["id"]] 254 | 255 | cli_alert_info("Creating cloud job {.val {job_name}}") 256 | 257 | cli_alert_info("Uploading package tarball") 258 | curl::curl_upload(tarball, presigned_url, verbose = FALSE) 259 | cli_alert_success("Uploaded package tarball") 260 | 261 | cli_alert_info("Spawning batch job") 262 | patch_response <- PATCH( 263 | "https://xgyefaepu5.execute-api.us-east-1.amazonaws.com", 264 | config = add_headers("x-api-key" = Sys.getenv("RSTUDIO_CLOUD_REVDEP_KEY")), 265 | path = paste0("staging/check", "/", job_name), 266 | body = list(status = "running"), 267 | encode = "json" 268 | ) 269 | cloud_stop_for_status(patch_response) 270 | cli_alert_success("Spawned batch job") 271 | 272 | patch_content <- content(patch_response) 273 | job_name <- patch_content$id 274 | 275 | # Create output directory and set as active job 276 | cloud_job(job_name = job_name) 277 | cloud <- dir_find(pkg, "cloud") 278 | out_dir <- file.path(cloud, job_name) 279 | dir.create(out_dir, showWarnings = FALSE, recursive = TRUE, mode = "744") 280 | cloud_job(job_name) 281 | 282 | cli_alert("Run {.run revdepcheck::cloud_status()} to monitor job status") 283 | 284 | invisible(job_name) 285 | } 286 | 287 | #' Cancel a running cloud run 288 | #' 289 | #' @inheritParams cloud_report 290 | #' @family cloud 291 | #' @export 292 | cloud_cancel <- function(job_name = cloud_job()) { 293 | patch_response <- PATCH( 294 | "https://xgyefaepu5.execute-api.us-east-1.amazonaws.com", 295 | config = add_headers("x-api-key" = Sys.getenv("RSTUDIO_CLOUD_REVDEP_KEY")), 296 | path = paste0("staging/check", "/", job_name), 297 | body = list(status = "cancelled"), 298 | encode = "json" 299 | ) 300 | 301 | cloud_stop_for_status(patch_response) 302 | } 303 | 304 | #' @importFrom httr status_code content headers http_status 305 | cloud_stop_for_status <- function(response) { 306 | if (status_code(response) < 300) { 307 | return() 308 | } 309 | 310 | heads <- headers(response) 311 | res <- content(response) 312 | status <- status_code(response) 313 | 314 | msg <- c( 315 | paste0("Cloud error (", status, "): ", http_status(status)$reason), 316 | paste0("Message: ", res$invalid_values %||% res$message) 317 | ) 318 | 319 | call <- sys.call(-1) 320 | 321 | cond <- structure( 322 | list( 323 | message = paste0(msg, collapse = "\n") 324 | ), 325 | class = c( 326 | "cloud_error", 327 | paste0("http_error_", status), 328 | "error", 329 | "condition" 330 | ) 331 | ) 332 | 333 | stop(cond) 334 | } 335 | 336 | cloud_check_result <- function(check_log, description, dependency_error) { 337 | check_dir <- dirname(check_log) 338 | 339 | if (!file.exists(check_log)) { 340 | return(structure( 341 | list( 342 | stdout = character(), 343 | timeout = FALSE, 344 | status = -1L, 345 | 346 | rversion = NA_character_, 347 | platform = NA_character_, 348 | errors = NA_character_, 349 | warnings = NA_character_, 350 | notes = NA_character_, 351 | 352 | description = description$str(normalize = FALSE), 353 | # DESCRIPTION can exist but be empty, e.g. for a Bioconductor package 354 | # or a when package's minimum R version isn't met 355 | # at the VERY LEAST, let's get a package name 356 | package = description$get_field( 357 | "Package", 358 | sub("[.]Rcheck$", "", basename(check_dir)) 359 | ), 360 | version = description$get("Version")[[1]], 361 | cran = description$get_field("Repository", "") == "CRAN", 362 | bioc = description$has_fields("biocViews"), 363 | 364 | checkdir = check_dir, 365 | test_fail = rcmdcheck:::get_test_fail(check_dir), 366 | install_out = rcmdcheck:::get_install_out(check_dir), 367 | 368 | type = "cloud" 369 | ), 370 | class = "rcmdcheck" 371 | )) 372 | } 373 | 374 | stdout <- brio::read_file(check_log) 375 | # Fix invalid characters 376 | stdout <- iconv(stdout, "UTF-8", "UTF-8", sub = "bytes") 377 | # Strip \r 378 | stdout <- gsub("\r\n", "\n", stdout, fixed = TRUE) 379 | 380 | entries <- strsplit(paste0("\n", stdout), "\n\\*+[ ]")[[1]][-1] 381 | 382 | notdone <- function(x) grep("^DONE", x, invert = TRUE, value = TRUE) 383 | 384 | res <- structure( 385 | list( 386 | stdout = stdout, 387 | timeout = FALSE, 388 | status = if (isTRUE(dependency_error)) -1L else 0L, 389 | 390 | rversion = rcmdcheck:::parse_rversion(entries), 391 | platform = rcmdcheck:::parse_platform(entries), 392 | errors = notdone(grep("ERROR\n", entries, value = TRUE)), 393 | warnings = notdone(grep("WARNING\n", entries, value = TRUE)), 394 | notes = notdone(grep("NOTE\n", entries, value = TRUE)), 395 | 396 | description = description$str(normalize = FALSE), 397 | package = description$get("Package"), 398 | version = description$get("Version")[[1]], 399 | cran = description$get_field("Repository", "") == "CRAN", 400 | bioc = description$has_fields("biocViews"), 401 | 402 | checkdir = check_dir, 403 | test_fail = rcmdcheck:::get_test_fail(check_dir), 404 | install_out = rcmdcheck:::get_install_out(check_dir), 405 | 406 | type = "cloud" 407 | ), 408 | class = "rcmdcheck" 409 | ) 410 | 411 | res 412 | } 413 | 414 | cloud_compare <- function(pkg) { 415 | desc_path <- file.path(pkg, "DESCRIPTION") 416 | if (!file.exists(desc_path)) { 417 | return(rcmdcheck_error(basename(pkg), old = NULL, new = NULL)) 418 | } 419 | description <- desc::desc(file = desc_path) 420 | 421 | old <- file.path(pkg, "old", paste0(basename(pkg), ".Rcheck"), "00check.log") 422 | new <- file.path(pkg, "new", paste0(basename(pkg), ".Rcheck"), "00check.log") 423 | 424 | dependency_path <- file.path(pkg, "dependency_install.log") 425 | dependency_error <- any(grep( 426 | "ERROR: .*is not available for package", 427 | readLines(dependency_path, warn = FALSE) 428 | )) || 429 | !(file.exists(old) && file.exists(new)) 430 | old <- cloud_check_result(old, description, dependency_error) 431 | new <- cloud_check_result(new, description, dependency_error) 432 | if (isTRUE(dependency_error)) { 433 | # DESCRIPTION can exist but be empty, e.g. for a Bioconductor package 434 | # or a when package's minimum R version isn't met 435 | # at the VERY LEAST, let's get a package name 436 | res <- rcmdcheck_error( 437 | description$get_field("Package", basename(pkg)), 438 | old, 439 | new 440 | ) 441 | res$version <- description$get("Version")[[1]] 442 | return(res) 443 | } 444 | rcmdcheck::compare_checks(old, new) 445 | } 446 | 447 | #' Display revdep results 448 | #' 449 | #' Displays nicely formatted results of processed packages run in the cloud. 450 | #' @inheritParams cloud_report 451 | #' @family cloud 452 | #' @export 453 | cloud_summary <- function(job_name = cloud_job(pkg = pkg), pkg = ".") { 454 | results <- cloud_results(job_name = job_name, pkg = pkg) 455 | structure( 456 | results, 457 | class = "revdepcheck_results" 458 | ) 459 | } 460 | 461 | #' Display detailed revdep results from a cloud run 462 | #' 463 | #' @param revdep Name of the revdep package 464 | #' @inheritParams cloud_report 465 | #' @family cloud 466 | #' @export 467 | cloud_details <- function(job_name = cloud_job(pkg = pkg), revdep, pkg = ".") { 468 | pkg <- pkg_check(pkg) 469 | cloud <- dir_find(pkg, "cloud") 470 | 471 | res <- cloud_compare(file.path(cloud, job_name, revdep)) 472 | 473 | class(res) <- "revdepcheck_details" 474 | res 475 | } 476 | 477 | #' Markdown report of reverse dependency check results from the cloud 478 | #' 479 | #' You can use these functions to get intermediate reports of a running cloud check. 480 | #' @inheritParams revdep_report_summary 481 | #' @param results Results from [cloud_results()]. Expert use only. 482 | #' @param job_name The job name, as returned by [cloud_check()]. 483 | #' @param failures Save failures to disk? 484 | #' @inheritParams revdep_report 485 | #' @family cloud 486 | #' @export 487 | cloud_report <- function( 488 | job_name = cloud_job(pkg = pkg), 489 | pkg = ".", 490 | file = "", 491 | all = FALSE, 492 | results = NULL, 493 | failures = TRUE 494 | ) { 495 | pkg <- pkg_check(pkg) 496 | root <- dir_find(pkg, "root") 497 | 498 | if (is.null(results)) { 499 | results <- cloud_results(job_name, pkg) 500 | } 501 | 502 | cli_alert_info("Generating reports") 503 | 504 | cli_alert_info("Writing summary to {.file revdep/README.md}") 505 | cloud_report_summary( 506 | file = file.path(root, "README.md"), 507 | all = all, 508 | results = results, 509 | pkg = pkg 510 | ) 511 | 512 | cli_alert_info("Writing problems to {.file revdep/problems.md}") 513 | cloud_report_problems( 514 | file = file.path(root, "problems.md"), 515 | all = all, 516 | results = results, 517 | pkg = pkg 518 | ) 519 | 520 | if (failures) { 521 | cli_alert_info("Writing failures to {.file revdep/failures.md}") 522 | cloud_report_failures( 523 | file = file.path(root, "failures.md"), 524 | results = results, 525 | pkg = pkg 526 | ) 527 | } else { 528 | unlink(file.path(root, "failures.md")) 529 | } 530 | 531 | cli_alert_info("Writing CRAN comments to {.file revdep/cran.md}") 532 | revdep_report_cran( 533 | file = file.path(root, "cran.md"), 534 | results = results, 535 | pkg = pkg 536 | ) 537 | 538 | invisible() 539 | } 540 | 541 | #' @rdname cloud_report 542 | #' @export 543 | cloud_report_summary <- function( 544 | job_name = cloud_job(pkg = pkg), 545 | file = "", 546 | all = FALSE, 547 | pkg = ".", 548 | results = NULL 549 | ) { 550 | if (is.null(results)) { 551 | results <- cloud_results(job_name, pkg) 552 | } 553 | 554 | if (is_string(file) && !identical(file, "")) { 555 | file <- file(file, encoding = "UTF-8", open = "w") 556 | on.exit(close(file), add = TRUE) 557 | 558 | opts <- options("crayon.enabled" = FALSE) 559 | on.exit(options(opts), add = TRUE) 560 | } 561 | 562 | cat_header("Revdeps", file = file) 563 | revdeps <- report_revdeps(pkg = pkg, all = all, results = results) 564 | 565 | status <- revdeps$status 566 | n_issues <- revdeps$issues 567 | revdeps$status <- revdeps$issues <- NULL 568 | failed <- !(status %in% c("+", "-")) 569 | broken <- status == "-" 570 | if (!all) { 571 | broken <- broken & n_issues > 0 572 | } 573 | 574 | revdep_report_section("Failed to check", revdeps[failed, ], file = file) 575 | revdep_report_section("New problems", revdeps[broken, ], file = file) 576 | if (all) { 577 | revdep_report_section("All", revdeps, file = file) 578 | } 579 | 580 | invisible() 581 | } 582 | 583 | #' @rdname cloud_report 584 | #' @export 585 | cloud_report_problems <- function( 586 | job_name = cloud_job(pkg = pkg), 587 | pkg = ".", 588 | file = "", 589 | all = FALSE, 590 | results = NULL 591 | ) { 592 | if (is.null(results)) { 593 | results <- cloud_results(job_name, pkg) 594 | } 595 | revdep_report_problems(pkg = pkg, file = file, all = all, results = results) 596 | } 597 | 598 | #' @rdname cloud_report 599 | #' @export 600 | cloud_report_failures <- function( 601 | job_name = cloud_job(pkg = pkg), 602 | pkg = ".", 603 | file = "", 604 | results = NULL 605 | ) { 606 | if (is.null(results)) { 607 | results <- cloud_results(job_name, pkg) 608 | } 609 | revdep_report_failures(pkg = pkg, file = file, results = results) 610 | } 611 | 612 | #' @rdname cloud_report 613 | #' @export 614 | cloud_report_cran <- function( 615 | job_name = cloud_job(pkg = pkg), 616 | pkg = ".", 617 | results = NULL 618 | ) { 619 | if (is.null(results)) { 620 | results <- cloud_results(job_name, pkg) 621 | } 622 | revdep_report_cran(pkg = pkg, results = results) 623 | } 624 | 625 | #' @rdname cloud_report 626 | #' @export 627 | cloud_report_checklist <- function( 628 | job_name = cloud_job(pkg = pkg), 629 | pkg = ".", 630 | results = NULL 631 | ) { 632 | if (is.null(results)) { 633 | results <- cloud_results(job_name, pkg) 634 | } 635 | revdep_report_checklist(pkg = pkg, results = results) 636 | } 637 | 638 | 639 | #' Retrieve cloud results 640 | #' 641 | #' Intended for expert use only, this can be used as input to the [cloud_report()] and other functions. 642 | #' @inheritParams cloud_report 643 | #' @family cloud 644 | #' @keywords internal 645 | #' @export 646 | cloud_results <- function(job_name = cloud_job(pkg = pkg), pkg = ".") { 647 | pkg <- pkg_check(pkg) 648 | cloud <- dir_find(pkg, "cloud") 649 | 650 | cloud_fetch_results(job_name, pkg = pkg) 651 | 652 | cli_alert_info("Comparing results") 653 | pkgs <- list.dirs( 654 | file.path(cloud, job_name), 655 | full.names = TRUE, 656 | recursive = FALSE 657 | ) 658 | 659 | pb <- cli_progress_bar( 660 | format = "Processing package results: {pb_percent} ({basename(pkg)})", 661 | total = length(pkgs) 662 | ) 663 | out <- lapply(pkgs, function(pkg) { 664 | cli_progress_update(id = pb) 665 | cloud_compare(pkg) 666 | }) 667 | cli_progress_done(id = pb) 668 | out 669 | } 670 | 671 | #' @inheritParams cloud_report 672 | #' @inherit revdep_email 673 | #' @export 674 | cloud_email <- function( 675 | type = c("broken", "failed"), 676 | job_name = cloud_job(pkg = pkg), 677 | pkg = ".", 678 | packages = NULL, 679 | draft = FALSE 680 | ) { 681 | type <- match.arg(type) 682 | 683 | package_results <- cloud_results(job_name, pkg) 684 | 685 | if (!is.null(packages)) { 686 | to_keep <- map_lgl(package_results, function(x) x$package %in% packages) 687 | package_results <- package_results[to_keep] 688 | } 689 | 690 | status <- map_chr(package_results, rcmdcheck_status) 691 | 692 | cond <- switch( 693 | type, 694 | broken = status %in% c("-", "t-", "i-"), 695 | failed = status %in% c("i+", "t+") 696 | ) 697 | revdep_email_by_type(pkg, package_results[cond], type, draft = draft) 698 | 699 | invisible() 700 | } 701 | 702 | #' Return the current cloud job 703 | #' 704 | #' The `job_name` is automatically set by [cloud_check()] and is remembered for 705 | #' the duration of the current R session. If there is no active `job_name`, but 706 | #' there are local cloud check results, `job_name` is inferred from the most 707 | #' recently modified cloud check results. 708 | #' 709 | #' @param job_name If not `NULL`, sets the active `job_name` to the input. 710 | #' @inheritParams cloud_report 711 | #' @export 712 | cloud_job <- function(job_name = NULL, pkg = ".") { 713 | cloud_data$job_name <- job_name %||% cloud_data$job_name 714 | if (!is.null(cloud_data$job_name)) { 715 | return(invisible(cloud_data$job_name)) 716 | } 717 | 718 | pkg <- pkg_check(pkg) 719 | cloud <- dir_find(pkg, "cloud") 720 | if (dir.exists(cloud)) { 721 | cloud_dirs <- list.dirs(cloud, recursive = FALSE) 722 | } else { 723 | cloud_dirs <- character() 724 | } 725 | if (length(cloud_dirs) < 1) { 726 | stop( 727 | "Can't find any previous `revdepcheck::cloud_check()` results locally, can't discover `job_name`", 728 | call. = FALSE 729 | ) 730 | } 731 | 732 | latest <- cloud_dirs[which.max(file.info(cloud_dirs)$mtime)] 733 | cloud_data$job_name <- basename(latest) 734 | cli_alert_success( 735 | "Most recent cloud job {.arg job_name}: {.val {cloud_data$job_name}}" 736 | ) 737 | invisible(cloud_data$job_name) 738 | } 739 | 740 | cloud_data <- new.env(parent = emptyenv()) 741 | 742 | list_job_to_tbl <- function(x, status) { 743 | if (length(x$jobSummaryList) == 0) { 744 | return( 745 | data.frame( 746 | name = character(), 747 | index = integer(), 748 | created = .POSIXct(double()), 749 | started = .POSIXct(double()), 750 | stopped = .POSIXct(double()), 751 | status = character(), 752 | stringsAsFactors = FALSE 753 | ) 754 | ) 755 | } 756 | 757 | data.frame( 758 | name = x$jobSummaryList$jobId, 759 | index = x$jobSummaryList$arrayProperties$index, 760 | created = .POSIXct(x$jobSummaryList$createdAt / 1000), 761 | started = .POSIXct(x$jobSummaryList$startedAt / 1000), 762 | stopped = .POSIXct(x$jobSummaryList$stoppedAt / 1000), 763 | status = status, 764 | stringsAsFactors = FALSE 765 | ) 766 | } 767 | 768 | #' Plot the running time per package of a cloud job 769 | #' 770 | #' @inheritParams cloud_report 771 | #' @family cloud 772 | #' @export 773 | cloud_plot <- function(job_name = cloud_job()) { 774 | job_info <- cloud_job_info(job_name) 775 | 776 | packages <- data.frame( 777 | index = seq_along(job_info$revdep_packages) - 1, 778 | package = unlist(job_info$revdep_packages), 779 | stringsAsFactors = FALSE 780 | ) 781 | 782 | succeeded <- list_job_to_tbl( 783 | cloud_job_status(job_name, "SUCCEEDED"), 784 | "succeeded" 785 | ) 786 | 787 | failed <- list_job_to_tbl(cloud_job_status(job_name, "FAILED"), "failed") 788 | 789 | data <- rbind(succeeded, failed) 790 | 791 | data <- merge(data, packages) 792 | 793 | data$package <- forcats::fct_reorder(data$package, data$stopped, .desc = TRUE) 794 | 795 | ggplot2::ggplot(data) + 796 | ggplot2::geom_segment( 797 | ggplot2::aes( 798 | y = package, 799 | yend = ggplot2::after_stat(y), 800 | x = hms::as_hms(started - created), 801 | xend = hms::as_hms(stopped - created), 802 | color = status 803 | ) 804 | ) + 805 | ggplot2::scale_color_manual( 806 | values = c("succeeded" = "darkgrey", "failed" = "red") 807 | ) + 808 | ggplot2::scale_y_discrete( 809 | guide = ggplot2::guide_axis(check.overlap = TRUE) 810 | ) + 811 | ggplot2::guides(color = "none") + 812 | ggplot2::labs(x = NULL, y = NULL) + 813 | ggplot2::theme( 814 | panel.grid.major.y = ggplot2::element_blank(), 815 | panel.grid.minor.y = ggplot2::element_blank() 816 | ) 817 | } 818 | 819 | utils::globalVariables(c("package", "y", "started", "created", "stopped")) 820 | 821 | cloud_job_info <- function(job_name = cloud_job()) { 822 | response <- GET( 823 | "https://xgyefaepu5.execute-api.us-east-1.amazonaws.com", 824 | config = add_headers("x-api-key" = Sys.getenv("RSTUDIO_CLOUD_REVDEP_KEY")), 825 | path = paste0("staging/check", "/", job_name), 826 | encode = "json" 827 | ) 828 | 829 | cloud_stop_for_status(response) 830 | content(response, simplifyVector = TRUE) 831 | } 832 | 833 | cloud_job_status <- function( 834 | job_name = cloud_job(pkg = pkg), 835 | status = c( 836 | "ALL", 837 | "RUNNING", 838 | "SUBMITTED", 839 | "PENDENG", 840 | "RUNNABLE", 841 | "STARTING", 842 | "RUNNING", 843 | "SUCCEEDED", 844 | "FAILED" 845 | ), 846 | pkg = "." 847 | ) { 848 | status <- match.arg(status) 849 | 850 | if (status == "ALL") { 851 | status <- "" 852 | } else { 853 | status <- paste0("/", status) 854 | } 855 | 856 | response <- GET( 857 | "https://xgyefaepu5.execute-api.us-east-1.amazonaws.com", 858 | config = add_headers("x-api-key" = Sys.getenv("RSTUDIO_CLOUD_REVDEP_KEY")), 859 | path = paste0("staging/check", "/", job_name, "/", "status", status), 860 | encode = "json" 861 | ) 862 | 863 | stop_for_status(response) 864 | content(response) 865 | } 866 | 867 | #' Get a tibble of batch sub-job ids for all checked packages 868 | #' 869 | #' @inheritParams cloud_report 870 | #' @export 871 | cloud_job_mapping <- function(job_name = cloud_job()) { 872 | info <- cloud_job_info(job_name) 873 | 874 | tibble::tibble( 875 | package = info$revdep_packages, 876 | id = seq_along(info$revdep_packages) - 1 877 | ) 878 | } 879 | 880 | #' Retrieve the names broken or failed packages 881 | #' 882 | #' Broken packages are those whose checks got worse with the dev version. 883 | #' Failed packages are those whose cloud jobs failed, either because the spot 884 | #' instance was shut down by AWS or because the checks used too much memory and 885 | #' were killed. 886 | #' @inheritParams cloud_report 887 | #' @param install_failures Whether to include packages that failed to install. 888 | #' @param timeout_failures Whether to include packages that timed out. 889 | #' @family cloud 890 | #' @returns A character vector with the names of broken packages, to be passed to `cloud_check()`. 891 | #' @export 892 | cloud_broken <- function( 893 | job_name = cloud_job(pkg = pkg), 894 | pkg = ".", 895 | install_failures = FALSE, 896 | timeout_failures = FALSE 897 | ) { 898 | results <- cloud_results(job_name = job_name, pkg = pkg) 899 | broken <- map_lgl(results, is_broken, install_failures, timeout_failures) 900 | 901 | map_chr(results[broken], `[[`, "package") 902 | } 903 | 904 | #' @rdname cloud_broken 905 | #' @export 906 | cloud_failed <- function(job_name = cloud_job(pkg = pkg), pkg = ".") { 907 | unlist(cloud_job_status(job_name, status = "FAILED")$packages) 908 | } 909 | 910 | #' Browse to the AWS url for the job 911 | #' 912 | #' This is useful for closer inspection of individual jobs while they are 913 | #' running or after the fact. 914 | #' @param package If `NULL` browses to the URL of the overall job. If a package 915 | #' name, browses to the URL for that specific package job. 916 | #' @inheritParams cloud_report 917 | #' @family cloud 918 | #' @export 919 | cloud_browse <- function(job_name = cloud_job(), package = NULL) { 920 | info <- cloud_job_info(job_name) 921 | 922 | job_id <- info$batch_job_id 923 | 924 | if (is.null(package)) { 925 | utils::browseURL(sprintf( 926 | "https://console.aws.amazon.com/batch/home?region=us-east-1#jobs/array-job/%s", 927 | job_id 928 | )) 929 | return(invisible()) 930 | } 931 | 932 | mapping <- cloud_job_mapping(job_name) 933 | 934 | array_num <- mapping$id[mapping$package == package] 935 | 936 | utils::browseURL(sprintf( 937 | "https://console.aws.amazon.com/batch/home?region=us-east-1#jobs/detail/%s:%i", 938 | job_id, 939 | array_num 940 | )) 941 | } 942 | --------------------------------------------------------------------------------