From 305d7cbecd48ca92e5c737928d703f1891f471e7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?G=C3=A1bor=20Cs=C3=A1rdi?= Date: Mon, 20 Nov 2023 15:56:21 +0100 Subject: [PATCH] Drop prettyunits dependency --- DESCRIPTION | 3 +- NAMESPACE | 1 - R/bioc-sysreqs.R | 2 +- R/progress-bar.R | 7 +-- R/repo-status.R | 2 +- R/sizes.R | 114 +++++++++++++++++++++++++++++++++++++++++++++++ R/time.R | 86 +++++++++++++++++++++++++++++++++++ 7 files changed, 207 insertions(+), 8 deletions(-) create mode 100644 R/sizes.R create mode 100644 R/time.R diff --git a/DESCRIPTION b/DESCRIPTION index 57e706ff..bc38622d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -12,7 +12,7 @@ License: MIT + file LICENSE URL: https://github.com/r-lib/pkgcache#readme, https://r-lib.github.io/pkgcache/ BugReports: https://github.com/r-lib/pkgcache/issues -Depends: +Depends: R (>= 3.4) Imports: callr (>= 2.0.4.9000), @@ -20,7 +20,6 @@ Imports: curl (>= 3.2), filelock, jsonlite, - prettyunits, processx (>= 3.3.0.9001), R6, rappdirs, diff --git a/NAMESPACE b/NAMESPACE index 4b766f9f..5e41674c 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -74,7 +74,6 @@ importFrom(curl,new_pool) importFrom(curl,parse_headers_list) importFrom(filelock,lock) importFrom(filelock,unlock) -importFrom(prettyunits,pretty_bytes) importFrom(processx,conn_get_fileno) importFrom(processx,process) importFrom(rappdirs,user_cache_dir) diff --git a/R/bioc-sysreqs.R b/R/bioc-sysreqs.R index 46380fa9..b9b1dcb2 100644 --- a/R/bioc-sysreqs.R +++ b/R/bioc-sysreqs.R @@ -47,7 +47,7 @@ get_all_bioc_sysreqs <- function(ref = "HEAD") { prog <- function() { cat( "\r[", paste(format(done), collapse = "/"), "]", sep = "", - " -- ", prettyunits::pretty_dt(Sys.time() - start_at) + " -- ", format_time$pretty_dt(Sys.time() - start_at) ) } diff --git a/R/progress-bar.R b/R/progress-bar.R index 32022982..51eedc17 100644 --- a/R/progress-bar.R +++ b/R/progress-bar.R @@ -52,7 +52,6 @@ update_progress_bar_done <- function(bar, url) { file.size(bar$data$path[[wh]]) } -#' @importFrom prettyunits pretty_bytes #' @importFrom cli cli_status_update show_progress_bar <- function(bar) { @@ -67,7 +66,9 @@ show_progress_bar <- function(bar) { current <- sum(data$current, na.rm = TRUE) total <- sum(data$size, na.rm = TRUE) downloads <- paste0( - "[", pretty_bytes(current), " / ", pretty_bytes(total), "]") + "[", format_bytes$pretty_bytes(current), " / ", + format_bytes$pretty_bytes(total), "]" + ) spinner <- bar$spinner$frames[bar$spinner_state] bar$spinner_state <- bar$spinner_state + 1L @@ -95,7 +96,7 @@ finish_progress_bar <- function(ok, bar) { } else if (FALSE %in% bar$data$uptodate) { dl <- vlapply(bar$data$uptodate, identical, FALSE) files <- sum(dl) - bytes <- pretty_bytes(sum(bar$data$size[dl], na.rm = TRUE)) + bytes <- format_bytes$pretty_bytes(sum(bar$data$size[dl], na.rm = TRUE)) cli_status_clear( bar$status, result = "done", diff --git a/R/repo-status.R b/R/repo-status.R index 6786cfb1..ad181d7c 100644 --- a/R/repo-status.R +++ b/R/repo-status.R @@ -163,7 +163,7 @@ print.pkgcache_repo_status_summary <- function(x, ...) { repo <- format(c("Repository summary:", x$repository)) ping <- format( - c("", paste0(" (", format(prettyunits::pretty_sec(x$ping)), ")")), + c("", paste0(" (", format(format_time$pretty_sec(x$ping)), ")")), justify = "right" ) ping <- sub("\\(NA.*\\)", " ", ping) diff --git a/R/sizes.R b/R/sizes.R new file mode 100644 index 00000000..1dacbc1f --- /dev/null +++ b/R/sizes.R @@ -0,0 +1,114 @@ + +format_bytes <- local({ + + pretty_bytes <- function(bytes, style = c("default", "nopad", "6")) { + + style <- switch( + match.arg(style), + "default" = pretty_bytes_default, + "nopad" = pretty_bytes_nopad, + "6" = pretty_bytes_6 + ) + + style(bytes) + } + + compute_bytes <- function(bytes, smallest_unit = "B") { + units0 <- c("B", "kB", "MB", "GB", "TB", "PB", "EB", "ZB", "YB") + + stopifnot( + is.numeric(bytes), + is.character(smallest_unit), + length(smallest_unit) == 1, + !is.na(smallest_unit), + smallest_unit %in% units0 + ) + + limits <- c(1000, 999950 * 1000 ^ (seq_len(length(units0) - 2) - 1)) + low <- match(smallest_unit, units0) + units <- units0[low:length(units0)] + limits <- limits[low:length(limits)] + + neg <- bytes < 0 & !is.na(bytes) + bytes <- abs(bytes) + + mat <- matrix( + rep(bytes, each = length(limits)), + nrow = length(limits), + ncol = length(bytes) + ) + mat2 <- matrix(mat < limits, nrow = length(limits), ncol = length(bytes)) + exponent <- length(limits) - colSums(mat2) + low - 1L + res <- bytes / 1000 ^ exponent + unit <- units[exponent - low + 2L] + + ## Zero bytes + res[bytes == 0] <- 0 + unit[bytes == 0] <- units[1] + + ## NA and NaN bytes + res[is.na(bytes)] <- NA_real_ + res[is.nan(bytes)] <- NaN + unit[is.na(bytes)] <- units0[low] # Includes NaN as well + + data.frame( + stringsAsFactors = FALSE, + amount = res, + unit = unit, + negative = neg + ) + } + + pretty_bytes_default <- function(bytes) { + szs <- compute_bytes(bytes) + amt <- szs$amount + + ## String. For fractions we always show two fraction digits + res <- character(length(amt)) + int <- is.na(amt) | amt == as.integer(amt) + res[int] <- format( + ifelse(szs$negative[int], -1, 1) * amt[int], + scientific = FALSE + ) + res[!int] <- sprintf("%.2f", ifelse(szs$negative[!int], -1, 1) * amt[!int]) + + format(paste(res, szs$unit), justify = "right") + } + + pretty_bytes_nopad <- function(bytes) { + sub("^\\s+", "", pretty_bytes_default(bytes)) + } + + pretty_bytes_6 <- function(bytes) { + szs <- compute_bytes(bytes, smallest_unit = "kB") + amt <- szs$amount + + na <- is.na(amt) + nan <- is.nan(amt) + neg <- !na & !nan & szs$negative + l10 <- !na & !nan & !neg & amt < 10 + l100 <- !na & !nan & !neg & amt >= 10 & amt < 100 + b100 <- !na & !nan & !neg & amt >= 100 + + szs$unit[neg] <- "kB" + + famt <- character(length(amt)) + famt[na] <- " NA" + famt[nan] <- "NaN" + famt[neg] <- "< 0" + famt[l10] <- sprintf("%.1f", amt[l10]) + famt[l100] <- sprintf(" %.0f", amt[l100]) + famt[b100] <- sprintf("%.0f", amt[b100]) + + paste0(famt, " ", szs$unit) + } + + structure( + list( + .internal = environment(), + pretty_bytes = pretty_bytes, + compute_bytes = compute_bytes + ), + class = c("standalone_bytes", "standalone") + ) +}) diff --git a/R/time.R b/R/time.R new file mode 100644 index 00000000..5cdd5a4a --- /dev/null +++ b/R/time.R @@ -0,0 +1,86 @@ +format_time <- local({ + assert_diff_time <- function(x) { + stopifnot(inherits(x, "difftime")) + } + + parse_ms <- function(ms) { + stopifnot(is.numeric(ms)) + + data.frame( + days = floor(ms / 86400000), + hours = floor((ms / 3600000) %% 24), + minutes = floor((ms / 60000) %% 60), + seconds = round((ms / 1000) %% 60, 1) + ) + } + + first_positive <- function(x) which(x > 0)[1] + + trim <- function(x) gsub("^\\s+|\\s+$", "", x) + + pretty_ms <- function(ms, compact = FALSE) { + stopifnot(is.numeric(ms)) + + parsed <- t(parse_ms(ms)) + + if (compact) { + units <- c("d", "h", "m", "s") + parsed2 <- parsed + parsed2[] <- paste0(parsed, units) + idx <- cbind( + apply(parsed, 2, first_positive), + seq_len(length(ms)) + ) + tmp <- paste0("~", parsed2[idx]) + + # handle NAs + tmp[is.na(parsed2[idx])] <- NA_character_ + tmp + } else { + ## Exact for small ones + exact <- paste0(ceiling(ms), "ms") + exact[is.na(ms)] <- NA_character_ + + ## Approximate for others, in seconds + merge_pieces <- function(pieces) { + ## handle NAs + if (all(is.na(pieces))) { + return(NA_character_) + } + + ## handle non-NAs + paste0( + if (pieces[1]) paste0(pieces[1], "d "), + if (pieces[2]) paste0(pieces[2], "h "), + if (pieces[3]) paste0(pieces[3], "m "), + if (pieces[4]) paste0(pieces[4], "s ") + ) + } + approx <- trim(apply(parsed, 2, merge_pieces)) + + ifelse(ms < 1000, exact, approx) + } + } + + pretty_sec <- function(sec, compact = FALSE) { + pretty_ms(sec * 1000, compact = compact) + } + + pretty_dt <- function(dt, compact = FALSE) { + assert_diff_time(dt) + + units(dt) <- "secs" + + pretty_sec(as.vector(dt), compact = compact) + } + + structure( + list( + .internal = environment(), + pretty_ms = pretty_ms, + pretty_sec = pretty_sec, + pretty_dt = pretty_dt + ), + class = c("standalone_time", "standalone") + ) +})