Merge pull request #5 from kforner/cli_table

switched to clitable.

Author: kforner

.devcontainer/devcontainer.json

@@ -22,7 +22,7 @@
 
     // search for APT R packages with: `apt-cache search "^r-.*" | sort`
     ,"ghcr.io/rocker-org/devcontainer-features/apt-packages:1.0.2": {
-      "packages": "bash-completion,pandoc,qpdf,r-cran-assertthat,r-cran-debugme,r-cran-cli,r-cran-covr,r-cran-dt,r-cran-htmltools,r-cran-huxtable,r-cran-igraph,r-cran-scales"
+      "packages": "bash-completion,pandoc,qpdf,r-cran-assertthat,r-cran-debugme,r-cran-cli,r-cran-clitable,r-cran-covr,r-cran-dt,r-cran-htmltools,r-cran-igraph"
     }
 
 	},

DESCRIPTION

@@ -9,21 +9,20 @@ Description: Manage a collection/library of R source packages. Discover, documen
 License: GPL (>= 3)
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.2
 URL: https://github.com/kforner/srcpkgs
 BugReports: https://github.com/kforner/srcpkgs/issues
 Imports:
   cli,
+  clitable,
   devtools,
   pkgload,
   testthat,
   stats,
   utils
 Suggests: 
-    huxtable,
     knitr,
     rmarkdown,
-    scales,
     withr
 Config/testthat/edition: 3
 VignetteBuilder: knitr

NAMESPACE

@@ -30,5 +30,7 @@ export(pkgs_test)
 export(reset)
 export(settings)
 export(unhack_r_loaders)
+importFrom(cli,cli_text)
+importFrom(clitable,cli_table)
 importFrom(testthat,test_dir)
 importFrom(utils,getFromNamespace)

R/1_imports.R

@@ -0,0 +1,3 @@
+#' @importFrom cli          cli_text
+#' @importFrom clitable    cli_table
+NULL

R/pkg_test.R

@@ -8,7 +8,7 @@
 #' @param export_all  passed to [pkg_load()]. Enables the test functions to easily access to non-exported
 #'                    functions. Caveat: If the pkg is already loaded and up-to-date with export_all=FALSE, it will not work.
 #' @param ...   passed to `testthat::test_dir()`
-#' @return the results as a `pkg_test` object, or NULL if no tests found
+#' @return the results as a `pkg_test` object, which is an empty listL if no tests were found
 #' @importFrom testthat   test_dir
 #' @export
 #' @examples
@@ -32,16 +32,22 @@ pkg_test <- function(pkgid, filter = NULL, src_pkgs = get_srcpkgs(), export_all
   pkg_load(pkg, src_pkgs, quiet = quiet, export_all = export_all)
 
   test_path <- file.path(pkg$path, "tests/testthat")
-  if (!dir.exists(test_path) || length(dir(test_path)) == 0) return(invisible())
 
-  res <- testthat::test_dir(test_path, filter = filter, stop_on_failure = FALSE, ...)
+  if (!dir.exists(test_path) || length(dir(test_path)) == 0) {
+    # no tests found, return an empty  pkg_test
+    return(invisible(new_pkg_test(pkg)))
+  }
 
-  attr(res, 'pkg') <- pkg
-  class(res) <- c('pkg_test', class(res))
+  res <- testthat::test_dir(test_path, filter = filter, stop_on_failure = FALSE, ...)
 
-  invisible(res)
+  invisible(new_pkg_test(pkg, res))
 }
 
+new_pkg_test <- function(pkg_name, test_results = list()) {
+  attr(test_results, 'pkg') <- pkg_name
+  class(test_results) <- c('pkg_test', class(test_results))
+  test_results
+}
 
 # tells if the test is successful
 # N.B: this is not a roxygen comment ON PURPOSE
@@ -80,14 +86,32 @@ fortify_pkg_test <- function(df) {
 
 #' @export
 as.data.frame.pkg_test <- function(x, ...) {
+  if (!length(x)) {
+    return(data.frame(
+      file = character(0), 
+      test = character(0), 
+      nb = integer(0), 
+      failed = integer(0), 
+      passed = integer(0), 
+      skipped = logical(0), 
+      error = logical(0), 
+      warning = integer(0), 
+      time = numeric(0))
+    )
+  }
   fortify_pkg_test(NextMethod())
 }
 
 #' @export
 print.pkg_test <- function(x, ...) {
   pkg <- attr(x, 'pkg')
-  df <- as.data.frame(x)
 
+  if (!length(x)) {
+    cli::cli_h1(paste0("package ", pkg$package, " has no tests"))
+    return(invisible())
+  }
+
+  df <- as.data.frame(x)
   results <- df$result
 
   ### by test
@@ -115,6 +139,19 @@ print.pkg_test <- function(x, ...) {
 # N.B: this is not a roxygen comment ON PURPOSE
 #' @export
 summary.pkg_test <- function(object, col = 'file', ...) {
+  if (!length(object)) {
+    return(data.frame(
+      file = character(0), 
+      nb = integer(0), 
+      failed = integer(0), 
+      passed = integer(0), 
+      skipped = logical(0), 
+      error = logical(0), 
+      warning = integer(0), 
+      time = numeric(0))
+    )
+  }
+
   df <- as.data.frame(object)
 
   stop_unless(length(col) <= 1, "col must be a column name or NULL")

R/pkgs_test.R

@@ -24,6 +24,10 @@ pkgs_test <- function(pkgids = names(filter_srcpkgs(src_pkgs, filter)), src_pkgs
 #' @export
 as.data.frame.pkgs_test <- function(x, ...) {
   .row <- function(test_res) {
+    if (!length(test_res)) {
+      return(data.frame(nb = 0L, failed = 0L, passed = 0L, skipped = 0L, error = 0L, warning = 0L, time = 0))
+    }
+
     if (is_error(test_res)) {
       # trick to create an empty data frame like test_results
 

R/text_table.R

@@ -1,68 +1,6 @@
-print_text_table_with_huxtable <- function(df, title = NULL, footnote = NULL, 
-  heatmap_columns = NULL, hilite_rows = NULL,
-  styler = huxtable_text_table_default_styler, ...) 
-{
-  ### build the huxtable
-  tt <- huxtable::as_hux(df)
 
-  if (length(footnote)) tt <- huxtable::add_footnote(tt, footnote)
-  if (length(title)) tt <- huxtable::set_caption(tt, title)
-  
-
-  if (length(styler)) tt <- styler(tt, heatmap_columns = heatmap_columns, hilite_rows = hilite_rows)
-
-  # now print
-  lines <- huxtable::to_screen(tt, max_width = Inf, colnames = FALSE)
-  cat(lines, sep = '\n')
-
-  invisible(tt)
-}
-
-huxtable_text_table_default_styler <- function(tt,  
-  heatmap_columns = NULL, heatmap_colorspace = c('green', 'red'),
-  hilite_rows = NULL,  hilite_bg = 'red'
-, fg = 'black', bg = '#f7f7f7') 
-{
-  ### set the title position: top
-  huxtable::caption_pos(tt) <- 'top'
-  ### make the header line BOLD
-  tt <- huxtable::set_bold(tt, 1, huxtable::everywhere, TRUE)
-
-  ### colors
-  tt <- huxtable::set_background_color(tt, 1, huxtable::everywhere, bg)
-  tt <- huxtable::set_text_color(tt, 1, huxtable::everywhere, fg)
-
-  ### hilite
-  tt <- huxtable::set_background_color(tt, hilite_rows + 1, huxtable::everywhere, hilite_bg)
-
-  ### heatmap
-  if (length(heatmap_columns))
-    for (col in heatmap_columns)
-      tt <- huxtable::map_background_color(tt, huxtable::everywhere, col, huxtable::by_colorspace(heatmap_colorspace))
-
-
-  ### borders
-  tt <- huxtable::set_bottom_border(tt, 1, huxtable::everywhere, 1)
-  tt <- huxtable::set_left_border(tt, 1)
-  tt <- huxtable::set_outer_borders(tt, 1)
-  tt <- huxtable::set_bottom_border(tt, huxtable::final(1), huxtable::everywhere, 1)
-
-  ### alignment
-  tt <- huxtable::set_align(tt, value = 'left')
-
-  tt
-}
-
-print_text_table_with_base <- function(df, ...) {
-  print(df)
-  invisible()
-}
-
-print_text_table <- function(df, ...) {
-  if (!requireNamespace("huxtable", quietly = TRUE)) {
-    print_text_table_with_base(df, ...)
-  } else {
-    print_text_table_with_huxtable(df, ...)
-  }
-  invisible()
-}
+print_text_table <- function(df, title = NULL, header_style = "bold", border_style = "double-single", ...) {
+  if (length(title)) cli::cli_h1(title)
+  ct <- cli_table(df, header_style = header_style, border_style = border_style, ...)
+  cat(ct, sep = "\n")
+}

dev.R

@@ -1,9 +1,13 @@
 library(devtools)
 
-
 check_man()
 
 test()
-test(filter = "pkg_load")
+test(filter = "config")
 test(filter = "pkg_check")
+test(filter = "pkg_load")
+test(filter = "pkg_test")
+test(filter = "pkgs_test")
 check()
+
+options(width = Sys.getenv("COLUMNS", 80))