Skip to content

Commit

Permalink
Do not import via NAMESPACE
Browse files Browse the repository at this point in the history
To make embedding easier into pak.
Run-time dependencies and base packages are OK.
  • Loading branch information
gaborcsardi committed Nov 21, 2023
1 parent ebae8ef commit 8e931f8
Show file tree
Hide file tree
Showing 10 changed files with 50 additions and 71 deletions.
11 changes: 0 additions & 11 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -48,17 +48,6 @@ export(repo_status)
export(with_repo)
if (getRversion() >= "4.0.0") importFrom(tools, R_user_dir)
importFrom(R6,R6Class)
importFrom(cli,cli_alert_info)
importFrom(cli,cli_process_done)
importFrom(cli,cli_process_start)
importFrom(cli,cli_status)
importFrom(cli,cli_status_clear)
importFrom(cli,cli_status_update)
importFrom(cli,get_spinner)
importFrom(cli,hash_obj_md5)
importFrom(curl,parse_headers_list)
importFrom(filelock,lock)
importFrom(filelock,unlock)
importFrom(tools,file_ext)
importFrom(utils,URLencode)
importFrom(utils,getSrcDirectory)
Expand Down
12 changes: 6 additions & 6 deletions R/archive.R
Original file line number Diff line number Diff line change
Expand Up @@ -264,7 +264,7 @@ cac_cleanup <- function(self, private, force) {
rep_etag <- paste0(rep_rds, "-etag")
unlink(c(rep_rds, rep_etag), recursive = TRUE, force = TRUE)
private$data <- NULL
cli_alert_info("Cleaning up archive cache in {.path {pri_rds}}.")
cli::cli_alert_info("Cleaning up archive cache in {.path {pri_rds}}.")
unlink(c(pri_rds, pri_etag, pri_lock), recursive = TRUE, force = TRUE)
invisible(self)
}
Expand Down Expand Up @@ -331,9 +331,9 @@ cac__load_primary <- function(self, private, max_age) {

pri_lock <- paste0(pri_file, "-lock")
mkdirp(dirname(pri_lock))
l <- lock(pri_lock, exclusive = FALSE, private$lock_timeout)
l <- filelock::lock(pri_lock, exclusive = FALSE, private$lock_timeout)
if (is.null(l)) stop("Cannot acquire lock to copy RDS")
on.exit(unlock(l), add = TRUE)
on.exit(filelock::unlock(l), add = TRUE)

if (!file.exists(pri_file)) stop("No primary RDS file in cache")
time <- file_get_time(pri_file)
Expand All @@ -345,7 +345,7 @@ cac__load_primary <- function(self, private, max_age) {
rep_etag <- paste0(rep_file, "-etag")
file_copy_with_time(pri_etag, rep_etag)

unlock(l)
filelock::unlock(l)

private$data <- readRDS(rep_file)
private$data_time <- time
Expand Down Expand Up @@ -422,9 +422,9 @@ cac__update_primary <- function(self, private, lock) {
if (lock) {
pri_lock <- paste0(pri_file, "-lock")
mkdirp(dirname(pri_lock))
l <- lock(pri_lock, exclusive = FALSE, private$lock_timeout)
l <- filelock::lock(pri_lock, exclusive = FALSE, private$lock_timeout)
if (is.null(l)) stop("Cannot acquire lock to copy RDS")
on.exit(unlock(l), add = TRUE)
on.exit(filelock::unlock(l), add = TRUE)
}

file_copy_with_time(rep_file, pri_file)
Expand Down
5 changes: 2 additions & 3 deletions R/async-http.R
Original file line number Diff line number Diff line change
Expand Up @@ -67,7 +67,6 @@ update_async_timeouts <- function(options) {
#' * `etag_file`: The file the ETag was written to, or `NULL` otherwise
#'
#' @family async HTTP tools
#' @importFrom curl parse_headers_list
#' @noRd
#' @section Examples:
#' ```
Expand Down Expand Up @@ -122,7 +121,7 @@ download_file <- function(url, destfile, etag_file = NULL,
then(function(resp) {
"!DEBUG downloaded `url`"
file.rename(tmp_destfile, destfile)
etag <- parse_headers_list(resp$headers)[["etag"]] %||% NA_character_
etag <- curl::parse_headers_list(resp$headers)[["etag"]] %||% NA_character_
if (!is.null(etag_file) && !is.na(etag[1])) {
mkdirp(dirname(etag_file))
writeLines(etag, etag_file)
Expand Down Expand Up @@ -245,7 +244,7 @@ download_if_newer <- function(url, destfile, etag_file = NULL,
} else if (resp$status_code == 200 || resp$status_code == 0) {
"!DEBUG downloaded `url`"
file.rename(tmp_destfile, destfile)
etag <- parse_headers_list(resp$headers)[["etag"]] %||% NA_character_
etag <- curl::parse_headers_list(resp$headers)[["etag"]] %||% NA_character_
if (!is.null(etag_file) && !is.na(etag[1])) {
mkdirp(dirname(etag_file))
writeLines(etag, etag_file)
Expand Down
49 changes: 23 additions & 26 deletions R/metadata-cache.R
Original file line number Diff line number Diff line change
Expand Up @@ -376,8 +376,6 @@ cmc_summary <- function(self, private) {
)
}

#' @importFrom cli cli_alert_info

cmc_cleanup <- function(self, private, force) {
if (!force && !interactive()) {
stop("Not cleaning up cache, please specify `force = TRUE`")
Expand All @@ -396,13 +394,16 @@ cmc_cleanup <- function(self, private, force) {
unlink(local_cache_dir, recursive = TRUE, force = TRUE)
private$data <- NULL
private$data_messaged <- NULL
cli_alert_info("Cleaning up cache directory {.path {cache_dir}}.")
cli::cli_alert_info("Cleaning up cache directory {.path {cache_dir}}.")
unlink(cache_dir, recursive = TRUE, force = TRUE)
}

#' @importFrom cli hash_obj_md5
#' @importFrom utils URLencode

hash_obj_md5 <- function(x, ...) {
cli::hash_obj_md5(x, ...)
}

repo_encode <- function(repos) {
paste0(
vcapply(repos$name, URLencode, reserved = TRUE), "-",
Expand Down Expand Up @@ -603,7 +604,6 @@ cmc__get_memory_cache <- function(self, private, max_age) {
#' as current.
#' @return The metadata.
#' @keywords internal
#' @importFrom cli cli_process_start cli_process_done

cmc__load_replica_rds <- function(self, private, max_age) {
"!!DEBUG Load replica RDS?"
Expand All @@ -613,13 +613,13 @@ cmc__load_replica_rds <- function(self, private, max_age) {
time <- file_get_time(rds)
if (Sys.time() - time > max_age) stop("Replica RDS cache file outdated")

sts <- cli_process_start("Loading metadata database")
sts <- cli::cli_process_start("Loading metadata database")
private$data <- readRDS(rds)
private$data_time <- time
private$data_messaged <- NULL
"!!DEBUG Loaded replica RDS!"
private$update_memory_cache()
cli_process_done(sts)
cli::cli_process_done(sts)

private$data
}
Expand All @@ -632,17 +632,16 @@ cmc__load_replica_rds <- function(self, private, max_age) {
#' @inheritParams cmc__load_replica_rds
#' @return Metadata.
#' @keywords internal
#' @importFrom cli cli_process_start cli_process_done

cmc__load_primary_rds <- function(self, private, max_age) {
"!!DEBUG Load primary RDS?"
pri_files <- private$get_cache_files("primary")
rep_files <- private$get_cache_files("replica")

mkdirp(dirname(pri_files$lock))
l <- lock(pri_files$lock, exclusive = FALSE, private$lock_timeout)
l <- filelock::lock(pri_files$lock, exclusive = FALSE, private$lock_timeout)
if (is.null(l)) stop("Cannot acquire lock to copy RDS")
on.exit(unlock(l), add = TRUE)
on.exit(filelock::unlock(l), add = TRUE)

if (!file.exists(pri_files$rds)) stop("No primary RDS file in cache")
time <- file_get_time(pri_files$rds)
Expand All @@ -655,16 +654,16 @@ cmc__load_primary_rds <- function(self, private, max_age) {
stop("Primary PACKAGES missing or newer than replica RDS, removing")
}

sts <- cli_process_start("Loading metadata database")
sts <- cli::cli_process_start("Loading metadata database")
file_copy_with_time(pri_files$rds, rep_files$rds)
unlock(l)
filelock::unlock(l)

private$data <- readRDS(rep_files$rds)
private$data_time <- time
private$data_messaged <- NULL

private$update_memory_cache()
cli_process_done(sts)
cli::cli_process_done(sts)

private$data
}
Expand All @@ -681,7 +680,6 @@ cmc__load_primary_rds <- function(self, private, max_age) {
#' @param max_age Max age to consider the files current.
#' @return Metadata.
#' @keywords internal
#' @importFrom cli cli_process_start cli_process_done

cmc__load_primary_pkgs <- function(self, private, max_age) {
"!!DEBUG Load replica PACKAGES*?"
Expand All @@ -690,9 +688,9 @@ cmc__load_primary_pkgs <- function(self, private, max_age) {

## Lock
mkdirp(dirname(pri_files$lock))
l <- lock(pri_files$lock, exclusive = FALSE, private$lock_timeout)
l <- filelock::lock(pri_files$lock, exclusive = FALSE, private$lock_timeout)
if (is.null(l)) stop("Cannot acquire lock to copy PACKAGES files")
on.exit(unlock(l), add = TRUE)
on.exit(filelock::unlock(l), add = TRUE)

## Check if PACKAGES exist and current. It is OK if metadata is missing
pkg_files <- pri_files$pkgs$path
Expand All @@ -705,15 +703,15 @@ cmc__load_primary_pkgs <- function(self, private, max_age) {
}

## Copy to replica, if we cannot copy the etags, that's ok
sts <- cli_process_start("Loading metadata database")
sts <- cli::cli_process_start("Loading metadata database")
private$copy_to_replica(rds = FALSE, pkgs = TRUE, etags = TRUE)

## Update RDS in replica, this also loads it
private$update_replica_rds(alert = FALSE)

## Update primary, but not the PACKAGES
private$update_primary(rds = TRUE, packages = FALSE, lock = FALSE)
cli_process_done(sts)
cli::cli_process_done(sts)

private$data
}
Expand Down Expand Up @@ -785,7 +783,7 @@ missing_pkgs_note <- function(pkgs, result) {
where <- vcapply(msgs, "[[", 2)
for (wt in unique(what)) {
wh <- unique(where[what == wt])
cli_alert_info("{wt} packages are missing from {wh}")
cli::cli_alert_info("{wt} packages are missing from {wh}")
}
}

Expand All @@ -797,11 +795,10 @@ missing_pkgs_note <- function(pkgs, result) {
#' @param private private self
#' @param alert whether to show message about the update
#' @keywords internal
#' @importFrom cli cli_process_start cli_process_done

cmc__update_replica_rds <- function(self, private, alert) {
"!!DEBUG Update replica RDS"
if (alert) sts <- cli_process_start("Updating metadata database")
if (alert) sts <- cli::cli_process_start("Updating metadata database")
rep_files <- private$get_cache_files("replica")

data_list <- lapply_rows(
Expand All @@ -827,7 +824,7 @@ cmc__update_replica_rds <- function(self, private, alert) {

private$update_memory_cache()

if (alert) cli_process_done(sts)
if (alert) cli::cli_process_done(sts)
private$data
}

Expand All @@ -851,9 +848,9 @@ cmc__update_primary <- function(self, private, rds, packages, lock) {

if (lock) {
mkdirp(dirname(pri_files$lock))
l <- lock(pri_files$lock, exclusive = TRUE, private$lock_timeout)
l <- filelock::lock(pri_files$lock, exclusive = TRUE, private$lock_timeout)
if (is.null(l)) stop("Cannot acquire lock to update primary cache")
on.exit(unlock(l), add = TRUE)
on.exit(filelock::unlock(l), add = TRUE)
}

if (rds) {
Expand Down Expand Up @@ -884,9 +881,9 @@ cmc__copy_to_replica <- function(self, private, rds, pkgs, etags) {
rep_files <- private$get_cache_files("replica")

mkdirp(dirname(pri_files$lock))
l <- lock(pri_files$lock, exclusive = FALSE, private$lock_timeout)
l <- filelock::lock(pri_files$lock, exclusive = FALSE, private$lock_timeout)
if (is.null(l)) stop("Cannot acquire lock to copy primary cache")
on.exit(unlock(l), add = TRUE)
on.exit(filelock::unlock(l), add = TRUE)

if (rds) {
file_copy_with_time(pri_files$rds, rep_files$rds)
Expand Down
2 changes: 1 addition & 1 deletion R/onload.R
Original file line number Diff line number Diff line change
Expand Up @@ -641,7 +641,7 @@ if (exists(".onLoad", inherits = FALSE)) {

get_cranlike_metadata_cache <- function() {
repos <- repo_get()
hash <- cli::hash_obj_md5(repos$url)
hash <- hash_obj_md5(repos$url)
if (is.null(pkgenv$global_metadata_cache[[hash]])) {
pkgenv$global_metadata_cache[[hash]] <- cranlike_metadata_cache$new()
}
Expand Down
12 changes: 6 additions & 6 deletions R/package-cache.R
Original file line number Diff line number Diff line change
Expand Up @@ -121,7 +121,7 @@ package_cache <- R6Class(

list = function() {
l <- private$lock(exclusive = FALSE)
on.exit(unlock(l), add = TRUE)
on.exit(filelock::unlock(l), add = TRUE)
dbfile <- get_db_file(private$path)
readRDS(dbfile)
},
Expand All @@ -132,7 +132,7 @@ package_cache <- R6Class(

copy_to = function(target, ..., .list = NULL) {
l <- private$lock(exclusive = FALSE)
on.exit(unlock(l), add = TRUE)
on.exit(filelock::unlock(l), add = TRUE)
res <- private$find_locked(..., .list = .list)
if (!is.null(target) && nrow(res) >= 1) {
mkdirp(dirname(target))
Expand All @@ -146,7 +146,7 @@ package_cache <- R6Class(
assert_that(is_existing_file(file))

l <- private$lock(exclusive = TRUE)
on.exit(unlock(l), add = TRUE)
on.exit(filelock::unlock(l), add = TRUE)
dbfile <- get_db_file(private$path)
db <- readRDS(dbfile)

Expand Down Expand Up @@ -294,7 +294,7 @@ package_cache <- R6Class(

delete = function(..., .list = NULL) {
l <- private$lock(exclusive = TRUE)
on.exit(unlock(l), add = TRUE)
on.exit(filelock::unlock(l), add = TRUE)
dbfile <- get_db_file(private$path)

ex <- private$find_locked(..., .list = .list)
Expand Down Expand Up @@ -345,8 +345,8 @@ create_empty_db_file_if_needed <- function(path) {

df <- make_empty_db_data_frame()

l <- lock(lockfile)
on.exit(unlock(l))
l <- filelock::lock(lockfile)
on.exit(filelock::unlock(l))
save_rds(df, dbfile)
}

Expand Down
20 changes: 7 additions & 13 deletions R/progress-bar.R
Original file line number Diff line number Diff line change
@@ -1,19 +1,17 @@

#' @importFrom cli get_spinner cli_status

create_progress_bar <- function(data) {
bar <- new.env(parent = emptyenv())

if (isTRUE(getOption("pkg.show_progress", FALSE))) {
bar$status <- cli_status(
bar$status <- cli::cli_status(
"Checking for {nrow(data)} new metadata file{?s}",
.auto_close = FALSE
)
} else {
bar$status <- cli_status(character(), .auto_close = FALSE)
bar$status <- cli::cli_status(character(), .auto_close = FALSE)
}

bar$spinner <- get_spinner()
bar$spinner <- cli::get_spinner()
bar$spinner_state <- 1L

bar$data <- data
Expand Down Expand Up @@ -52,8 +50,6 @@ update_progress_bar_done <- function(bar, url) {
file.size(bar$data$path[[wh]])
}

#' @importFrom cli cli_status_update

show_progress_bar <- function(bar) {
if (is.null(bar$status) ||
!isTRUE(getOption("pkg.show_progress", FALSE))) {
Expand All @@ -76,18 +72,16 @@ show_progress_bar <- function(bar) {
bar$spinner_state <- 1L
}

cli_status_update(
cli::cli_status_update(
bar$status,
c("{spinner} Updating metadata database [{uptodate}/{numfiles}] | ",
"Downloading {downloads}")
)
}

#' @importFrom cli cli_status_clear

finish_progress_bar <- function(ok, bar) {
if (!ok) {
cli_status_clear(
cli::cli_status_clear(
bar$status,
result = "failed",
msg_failed = "{.alert-danger Metadata update failed}"
Expand All @@ -97,14 +91,14 @@ finish_progress_bar <- function(ok, bar) {
dl <- vlapply(bar$data$uptodate, identical, FALSE)
files <- sum(dl)
bytes <- format_bytes$pretty_bytes(sum(bar$data$size[dl], na.rm = TRUE))
cli_status_clear(
cli::cli_status_clear(
bar$status,
result = "done",
msg_done = "{.alert-success Updated metadata database: {bytes} in {files} file{?s}.}"
)

} else {
cli_status_clear(bar$status)
cli::cli_status_clear(bar$status)
}

bar$status <- NULL
Expand Down
Loading

0 comments on commit 8e931f8

Please sign in to comment.