Drop prettyunits dependency

DESCRIPTION

@@ -12,15 +12,14 @@ 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),
     cli (>= 3.2.0),
     curl (>= 3.2),
     filelock,
     jsonlite,
-    prettyunits,
     processx (>= 3.3.0.9001),
     R6,
     rappdirs,

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)

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)
     )
   }
 

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",

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)

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")
+  )
+})

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")
+  )
+})