2 progress

.lintr

@@ -1,3 +1,5 @@
-linters: linters_with_defaults() # see vignette("lintr")
+linters: linters_with_defaults(
+ indentation_linter = NULL
+ )
 encoding: "UTF-8"
 exclusions: list("tests/spelling.R")

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: echo
 Title: Echo Code Evaluations
-Version: 0.1.0.9000
+Version: 0.1.0.9001
 Authors@R:
  person(given = "Jordan Mark",
  family = "Barbone",
@@ -21,7 +21,7 @@ Suggests:
  testthat (>= 3.0.0)
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.0
 URL: https://github.com/jmbarbone/echo,
  https://jmbarbone.github.io/echo/
 BugReports: https://github.com/jmbarbone/echo/issues

NEWS.md

@@ -1,3 +1,7 @@
+
 # echo 0.1.0.9000
 
+* `echo()` gains new `progress` param to print a progress bar, similar to `utils::txtProgressBar(style = 3)` [#2](https://github.com/jmbarbone/echo/issues/2)
+* `echo()` now handles single expressions better (e.g., `echo({ letters })` and `echo(letters)` should produce the same result)
+* `echo()` gains new `expr` param to evaluate an `expression` object instead of `expr` or `file`
 * Added a `NEWS.md` file to track changes to the package.

R/echo-classes.R

@@ -1,9 +1,17 @@
 
-echo_echo <- function(x, level = "NUL") {
+echo_echo <- function(x, level = "NUL", p = NULL) {
  if (echo_get_level() > level) {
  return(invisible())
  }
 
+ if (inherits(p, "echo_progress")) {
+ p$flush()
+ on.exit(p$show(), add = TRUE)
+ }
+
+ op <- options(width = getOption("echo.width", getOption("width", 80L)))
+ on.exit(options(op), add = TRUE)
+
  print(x)
 }
 
@@ -36,32 +44,32 @@ print.echo_err <- function(x, ...) {
  catln(paste0(time(), "[ERR] #> ", x))
 }
 
-echo_exp <- function(x) {
- echo_class("exp", x)
+echo_exp <- function(x, p = NULL) {
+ echo_class("exp", x, p = p)
 }
 
-echo_out <- function(x) {
- echo_class("out", x)
+echo_out <- function(x, p = NULL) {
+ echo_class("out", x, p = p)
 }
 
-echo_msg <- function(x) {
- echo_class("msg", x)
+echo_msg <- function(x, p = NULL) {
+ echo_class("msg", x, p = p)
 }
 
-echo_wrn <- function(x) {
- echo_class("wrn", x)
+echo_wrn <- function(x, p = NULL) {
+ echo_class("wrn", x, p = p)
 }
 
-echo_err <- function(x) {
- echo_class("err", x)
+echo_err <- function(x, p = NULL) {
+ echo_class("err", x, p = p)
 }
 
-echo_class <- function(class, text) {
+echo_class <- function(class, text, p = NULL) {
  stopifnot(toupper(class) %in% level_levels())
  x <- structure(
  text,
  class = c("echo_echo", paste0("echo_", class), "list")
  )
 
- echo_echo(x, level = toupper(class))
+ echo_echo(x, level = toupper(class), p = p)
 }

R/echo.R

@@ -18,18 +18,21 @@
 #' Timestamps are printed in UTC by default. To control this, set the option
 #' value, such as `options(echo.timezone = "EST")`.
 #'
-#' @param expr Expression to evaluate; should be written with curly braces (see
-#' examples)
+#' @param expr Expression to evaluate. This can be a single expression.
+#' expressions within braces (i.e., `{ ... }`).
 #' @param log A connection or file name for outputs; defaults to `stdout()`
 #' @param msg Logical, if `FALSE` does not output a message; defaults to `TRUE`
 #' @param level Sets the echo level (see details); defaults to `0L`
 #' @param file File path to evaluate (like [base::source()]). If `file` is not
 #' `NULL`, then `expr` must be missing`
+#' @param exprs Expressions to evaluate. This can be a single `expression`.
+#' @param progress Logical, if `TRUE` shows a progress bar; defaults to `FALSE`
 #' @returns Nothing, called for side-effects
 #' @examples
 #' # make sure to use braces for expr
-#' echo(letters, level = 0) # bad
-#' echo({letters}, level = 0) # good
+#' echo({ letters }, level = 0) # good
+#' echo({letters}, level = 0) # still good
+#' echo(letters, level = 0) # also good
 #'
 #' try(echo(
 #' expr = {
@@ -43,7 +46,6 @@
 #' level = 0
 #' ))
 #'
-#'
 #' # Parse lines in a file instead
 #' try(echo(file = system.file("example-script.R", package = "echo")))
 #'
@@ -60,13 +62,15 @@ echo <- function(
  log = echo_get_log(), #> stdout()
  msg = echo_get_msg(), #> TRUE
  level = echo_get_level(),
- file = NULL
+ file = NULL,
+ exprs = NULL,
+ progress = getOption("echo.progress", FALSE)
 ) {
  op <- options(
  echo.msg = msg,
  echo.log = log,
  echo.level = level,
- width = max(getOption("width") - 37, 30)
+ echo.width = max(getOption("width") - 37, 30)
  )
  on.exit(options(op), add = TRUE)
 
@@ -77,43 +81,65 @@ echo <- function(
  stop("If 'file' is not NULL, 'expr' must be missing", call. = FALSE)
  }
  expr <- parse(file)
+ } else if (!is.null(exprs)) {
+ if (!missing(expr)) {
+ stop("If 'exprs' is not NULL, 'expr' must be missing", call. = FALSE)
+ }
+ stopifnot(inherits(exprs, "expression"))
+ expr <- as.expression(exprs)
+ } else {
+ expr <- as.list(substitute(expr))
+ if (identical(expr[[1]], quote(`{`))) {
+ expr <- expr[-1]
+ }
+ }
+
+ if (progress) {
+ progress <- echo_progress
  } else {
- expr <- as.list(substitute(expr))[-1]
+ progress <- echo_null
  }
 
- # TODO add functions for other controls
+ progress$reset()
+ progress$total <- length(expr)
  for (ex in expr) {
- evaluate(ex, env = env)
+ evaluate(ex, env = env, progress = progress)
  }
 
  invisible()
 }
 
-evaluate <- function(expr, env = env) {
+evaluate <- function(expr, env = env, progress = echo_null) {
  dep <- deparse1(expr)
+ progress$flush()
  echo_exp(dep)
+ progress$show()
 
+ # FIXME include progress$flush(), $show() in echo_echo()
  output <- utils::capture.output(value <- tryCatch(
  eval(as.expression(expr), envir = env),
  message = function(e) {
- echo_msg(conditionMessage(e))
+ echo_msg(conditionMessage(e), p = progress)
  tryInvokeRestart("muffleMessage")
  },
  warning = function(e) {
- echo_wrn(conditionMessage(e))
+ echo_wrn(conditionMessage(e), p = progress)
  tryInvokeRestart("muffleWarning")
  },
  error = function(e) {
- echo_err(conditionMessage(e))
+ progress$flush()
+ echo_err(conditionMessage(e), p = progress)
+ progress$show()
  stop("Error in ", dep, "\n ", conditionMessage(e), call. = FALSE)
  }
  ))
 
- if (is.null(value) && identical(output, character())) {
- utils::flush.console()
- } else {
+ if (!(is.null(value) && identical(output, character()))) {
+ progress$flush()
  echo_out(output)
  }
 
+ progress$add(1L)
+ progress$show()
  invisible(value)
 }