revdepcheck helpers

README.md

Script that helps me with revdepcheck

Getting setup

Download the scripts

get_gist <- function(where = "revdep/tools") {
  gist_id <- "7018c926b14ec45d1a34e70e018db2d5"
  fs::dir_create(where)
  gistr::gist_save(glue::glue("https://gist.github.com/cderv/{gist_id}"), where)
  files <- fs::dir_ls(glue::glue("{where}/{gist_id}"))
  for (f in files) {
    new <- fs::path(where, fs::path_file(f))
    if (fs::file_exists(new)) {
      cli::cli_alert_danger("File {.file {new}} already exists")
      next
    }
    fs::file_copy(f, where)
  }
  fs::dir_delete(glue::glue("{where}/{gist_id}"))
  cli::cli_alert_warning(cli::col_br_red("Fill in cloud URL and Job id"))
  return(fs::dir_ls(where))
}

get_gist()

Scripts

• checkerrors.R will help analyze the installation log
• revdepcheck.R will help run a local revdepchek on a subset of dependencies
• utils.R will help retrieve some information about the cloud revdep

checkerrors.R

# Set Job ID here:
id <- ""

# or see id in utils.R

cloud_res <- revdepcheck::cloud_results(id)
saveRDS(cloud_res, "revdep/tools/cloud-res.rds")

revdepcheck::cloud_summary(id)
revdepcheck::cloud_report(id, results = cloud_res)

# Save file for run
folder <- glue::glue("revdep/{id}")
fs::dir_create(folder)
fs::file_copy(c("revdep/cran.md", "revdep/failures.md", "revdep/problems.md", "revdep/README.md"), folder)


# Install log -------------------------------------------------------------

files <- fs::dir_ls(glue::glue("revdep/cloud/{id}/"), glob = "*/dependency_install.log", recurse = TRUE)
files <- purrr::set_names(files, nm = basename(dirname(files)))

# Error 500
res <- purrr::map(files, ~ {
  content <- xfun::read_utf8(.x)
  error <- grep("ERROR 50\\d", content, value = TRUE)
  gsub("^.*(ERROR 50\\d.*)$", "\\1", error)
})

length(res)
res_issue <- purrr::compact(res)
if (length(res_issue)) range(purrr::map_int(res_issue, length))

# After retries - Download errors
res <- purrr::map(files, ~ {
  content <- xfun::read_utf8(.x)
  error <- grep("'wget' call had nonzero exit status", content, value = TRUE)
  stringr::str_trim(error)
})

length(res)
res_issue <- purrr::compact(res)
if (length(res_issue)) range(purrr::map_int(res_issue, length))
names(res_issue)

# Install Error - due to BIOC probably

pb <- cli::cli_progress_bar("Parsed files", total = length(files))
res <- purrr::map(files, ~ {
  cli::cli_progress_update(id = pb)
  content <- xfun::read_utf8(.x)
  error <- grep("ERROR: dependency .* is not available for package .*", content, value = TRUE)
  stringr::str_trim(error)
})

library(dplyr)

not_available <- tibble::enframe(purrr::compact(res))
not_available |> pull(name) |> sort() |> xfun::raw_string()

pb <- cli::cli_progress_bar("Parsed files", total = length(files))
res <- purrr::map(files, ~ {
  cli::cli_progress_update(id = pb)
  content <- xfun::read_utf8(.x)
  error <- grep("packages .* are not available for this version of R", content, value = TRUE)
  stringr::str_trim(error)
})

not_available2 <- tibble::enframe(purrr::compact(res))
not_available2 |> pull(name) |> sort() |> xfun::raw_string()


# Check log ---------------------------------------------------------------

# Save file for run
files <- fs::dir_ls(glue::glue("revdep/cloud/{id}/"), glob = "*/00check.log", recurse = TRUE)

pb <- cli::cli_progress_bar("Parsed files", total = length(files))
res <- purrr::map_lgl(files, ~ {
  cli::cli_progress_update(id = pb)
  content <- xfun::read_utf8(.x)
  error <- any(grepl("checking re-building of vignette outputs .* WARNING", content))
  error
})


tab <- tibble::tibble(
  package = purrr::map_chr(fs::path_split(files), 4),
  version = purrr::map_chr(fs::path_split(files), 5),
  file = files,
  vignette_error = res
)

tab %>%
  group_by(package, version) %>%
  summarise(sum_error = sum(vignette_error), .groups = "drop") %>%
  filter(sum_error > 0) %>%
  tidyr::pivot_wider(names_from = version, values_from = sum_error) %>%
  filter(new != old)

revdepcheck.R

## Manually run a revdep check for a subset of package ------------

# Initialize package and DB
pkg <- revdepcheck:::pkg_check(".")
revdepcheck:::db_setup(pkg)
db <- revdepcheck:::db(pkg)
DBI::dbListTables(db)

# Check todo - Should be empty or done
revdepcheck::revdep_todo()

# Add package to check
to_run <- c("EpiNow2","OncoBayes2","Sleuth3","bain","breathteststan","clustermq","insight","parameters","personalized")
cran_deps <- revdepcheck::cran_revdeps("quarto")
revdepcheck::revdep_add(packages = to_run)
# Add one other package
revdepcheck::revdep_add(packages = "intkrige")
# Remove a package
revdepcheck::revdep_rm(packages = "bain")

# Check to run
revdepcheck::revdep_todo()

# Set repo to RSPM
options(repos = c(CRAN = "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"))

# Run check
revdepcheck::revdep_check(timeout = as.difftime(5, units = "hours"), num_workers = 1)

utils.R

library(httr)

# Setup
id <- ""
cloud_url <- Sys.getenv("RSTUDIO_CLOUD_REVDEP_URL")
cloud_url <- modify_url(cloud_url, path = glue::glue("staging/check/{id}"))
auth_header <- add_headers('x-api-key' = Sys.getenv("RSTUDIO_CLOUD_REVDEP_KEY"))

# Get time ----------------------------------------------------------------
res <- GET(cloud_url, auth_header)
res <- content(res, as = "text")
jqr::jq(res, ".r_version")
res_time <- jqr::jq(res, '. | with_entries(select(.key | endswith("stamp")))')
res_time <- jsonlite::parse_json(res_time)

library(lubridate)
# run duration
as.period(ymd_hms(res_time$finished_timestamp) - ymd_hms(res_time$started_timestamp))

# Total duration
as.period(ymd_hms(res_time$finished_timestamp) - ymd_hms(res_time$created_timestamp))

# Get packages in Job status

res <- GET(glue::glue("{cloud_url}/status"), auth_header)
res <- content(res, as = "text")
jqr::jq(res)

res <- GET(glue::glue("{cloud_url}/status/SUCCEEDED"), auth_header)
res <- content(res, as = "text")
res <- jqr::jq(res, '.packages')
res

res <- GET(glue::glue("{cloud_url}/status/FAILED"), auth_header)
res <- content(res, as = "text")
res <- jqr::jq(res, '.packages')
pkgs_failed <- jsonlite::parse_json(res, simplifyVector = TRUE)
pkgs_failed

dput(pkgs_failed)

saveRDS(pkgs_failed, "revdep/tools/pkgs-failed.Rds")

reasons <- purrr::map(purrr::set_names(pkgs_failed), ~ {
  res <- GET(glue::glue("{cloud_url}/packages/{.x}"), auth_header)
  res <- content(res, as = "text")
  res <- jqr::jq(res, ".attempts[].statusReason")
  jsonlite::stream_in(textConnection(res))
})


print(tidyr::unnest_auto(tibble::enframe(purrr::map(reasons, "out")), "value"), n = Inf)

library(dplyr)

tibble::enframe(purrr::simplify(reasons)) %>%
  mutate(value = gsub("(Host EC2).*( terminated)", "\\1\\2", value)) %>%
  count(value)

# List revdeps -----------------------------------------------------

res <- GET(glue::glue("{cloud_url}/packages"), auth_header)
res <- content(res, as = "text")
res <- jqr::jq(res, ".revdep_packages")
revdep_pkg <- jsonlite::fromJSON(res)

# Result of a package -----------------------------------------------------

pkg <- pkgs_failed[1]
pkg <- "CausalImpact"
res <- GET(glue::glue("{cloud_url}/packages/{pkg}"), auth_header)
res <- content(res, as = "text")
jqr::jq(res, ".container.reason") # Out Of Memory issue ?
res <- jqr::jq(res)
res

## Status log of all packages
pb <- cli::cli_progress_bar("Retrieving", total = length(revdep_pkg))
res <- purrr::map(purrr::set_names(revdep_pkg), ~ {
  pkg <- .x
  cli::cli_progress_update(id = pb)
  res <- GET(glue::glue("{cloud_url}/packages/{pkg}"), auth_header)
  res <- content(res, as = "text", encoding = "UTF-8")
  jqr::jq(res, ".container.reason")
})

res2 <- purrr::map(res, jsonlite::fromJSON)
OOM_pkg <- tibble::enframe(purrr::simplify(purrr::compact(res2)))

setdiff(pkgs_failed, OOM_pkg$name)
intersect(pkgs_failed, OOM_pkg$name)
# Download ----------------------------------------------------------------
out  <- paste0(pkg, ".tar.gz")
res <- GET(glue::glue("{cloud_url}/packages/{pkg}/results.tar.gz"), auth_header, write_disk(out))
archive::archive(out)
res <- jqr::jq(res)

# Build report ------------------------------------------------------------
rmarkdown::render("revdep/failures.md", rmarkdown::html_document(toc = TRUE, toc_depth = 1, toc_float = TRUE))