Color the output

Closes #3.

R/package-info.R

@@ -260,27 +260,54 @@ format.packages_info <- function(x, ...) {
     px <- cbind("!" = prob, px)
   }
 
-  fmt <- c(format_df(px), "")
+  dng <- function(x) cli::bg_red(cli::col_white(x))
+
+  highlighters <- list(
+    "!" = function(x) {
+      ifelse(empty(x), x, dng(x))
+    },
+    version = function(x) {
+      highlight_version(x)
+    },
+    "date (UTC)" = function(x) {
+      cli::col_grey(x)
+    },
+    lib = function(x) {
+      cli::col_grey(x)
+    },
+    source = function(x) {
+      common <- grepl("^(Bioconductor|CRAN)", x)
+      x[!common] <- cli::style_bold(cli::col_magenta(x[!common]))
+      x[common] <- cli::col_grey(x[common])
+      x
+    }
+  )
+
+  fmt <- c(format_df(px, highlighters = highlighters), "")
 
   lapply(
     seq_along(levels(x$library)),
     function(i) {
-      fmt <<- c(fmt, paste0("[", i, "] ", levels(x$library)[i]))
+      fmt <<- c(fmt, cli::col_grey(paste0(" [", i, "] ", levels(x$library)[i])))
     }
   )
 
   if ("!" %in% names(px)) fmt <- c(fmt, "")
   if (any(badloaded)) {
-    fmt <- c(fmt, paste0(" V ", dash(2), " Loaded and on-disk version mismatch."))
+    fmt <- c(fmt, paste0(" ", dng("V"), " ", dash(2),
+                         " Loaded and on-disk version mismatch."))
   }
   if (any(badpath))  {
-    fmt <- c(fmt, paste0(" P ", dash(2), " Loaded and on-disk path mismatch."))
+    fmt <- c(fmt, paste0(" ", dng("P"), " ", dash(2),
+                         " Loaded and on-disk path mismatch."))
   }
   if (any(badmd5)) {
-    fmt <- c(fmt, paste0(" D ", dash(2), " DLL MD5 mismatch, broken installation."))
+    fmt <- c(fmt, paste0(" ", dng("D"), " ", dash(2),
+                         " DLL MD5 mismatch, broken installation."))
   }
   if (any(baddel)) {
-    fmt <- c(fmt, paste0(" R ", dash(2), " Package was removed from disk."))
+    fmt <- c(fmt, paste0(" ", dng("R"), " ", dash(2),
+                         " Package was removed from disk."))
   }
 
   fmt

R/printing.R

@@ -6,7 +6,8 @@ rule <- function (..., pad = NULL, double = FALSE) {
   title <- if (length(list(...))) paste0(" ", ..., " ") else ""
 
   width <- max(cli::console_width() - cli::ansi_nchar(title, "width") - 3, 0)
-  paste(pad, title, paste(rep(pad, width), collapse = ""), sep = "")
+  rule <- paste(pad, title, paste(rep(pad, width), collapse = ""), sep = "")
+  cli::style_bold(cli::col_cyan(rule))
 }
 
 dash <- function(n = 2) {
@@ -27,7 +28,7 @@ format_column <- function(name, x) {
   col_align(c(name, x))
 }
 
-format_df <- function(x) {
+format_df <- function(x, highlighters = NULL) {
   cols <- mapply(
     names(x),
     x,
@@ -36,6 +37,25 @@ format_df <- function(x) {
     SIMPLIFY = FALSE
   )
 
+  cols <- lapply(cols, function(x) {
+    if (length(x) > 0) x[1] <- cli::col_grey(cli::style_italic(x[1]))
+    x
+  })
+
+  for (idx in seq_along(highlighters)) {
+    colname <- names(highlighters)[idx]
+    colnum <- match(colname, names(x))
+    if (is.na(colnum)) next
+    cols[[colnum]][-1] <- highlighters[[idx]](cols[[colnum]][-1])
+  }
+
   # remove trailing space, to avoid superfluous wrapping
   trimws(do.call("paste", c("", cols)), "right")
 }
+
+highlight_version <- function(x) {
+  ver <- package_version(trimws(x))
+  large <- vapply(ver, function(x) any(unlist(x) >= 1234), logical(1))
+  x[large] <- cli::style_bold(cli::col_magenta(x[large]))
+  x
+}

R/session-info.R

@@ -93,7 +93,9 @@ session_info <- function(
   si <- add_hash(si)
 
   if (is_string(to_file)) {
-    writeLines(as.character(si), to_file)
+    old <- options(cli.num_colors = 1)
+    on.exit(options(old), add = TRUE)
+    writeLines(format(si), to_file)
     invisible(si)
   } else {
     si
@@ -149,7 +151,7 @@ has_emoji <- function () {
 emo_hash <- function(x) {
   if (is.null(x$hash)) return("")
   if (has_emoji()) {
-    paste0(" ", paste0(x$hash$emoji, " ", collapse = ""))
+    paste0(" ", paste(x$hash$emoji, " ", collapse = ""))
   } else {
     ""
   }

R/utils.R

@@ -33,3 +33,7 @@ drop_null <- function(x) {
 last <- function(x) {
   x[length(x)]
 }
+
+empty <- function(x) {
+  grepl("^\\s*$", x)
+}