Capture `{cli}` output for reporting-CodePudding

I would like to capture the dynamic output produced by {cli} to use in error reporting/logging.

Here's an example:

my_function <- function(val, return_message = TRUE) {
  
  if(val == 'a'){
    if (return_message) cli::cli_alert("your value {val} = a!")
  } else {
    if (return_message) cli::cli_alert("your value {val} is not equal to a!")
  }
  
  if (return_message) cli::cli_h2("processing now complete")
  
  return(val)
  
}

Using my_function, it returns val and also prints a message that is dynamic, based on the input value:

→ your value x is not equal to a!

── processing now complete ──

[1] "x"

Is there any way to capture the dynamic output from {cli} functions, ideally by appending to a list or a similar method?

Ideal output would be something like this:

my_data <- list(val = "x", message = c("your value x is not equal to a!", "processing now complete"))

CodePudding user response：

I don't think cli_X() returns the text, but you could imagine a wrapper that might do what you want. Consider this as a start:

cli_wrapper <- function(str, type="alert", return_str = TRUE, return_message=TRUE, ...){
  str <- with(list(...), glue::glue(str))
  if(return_message){
    cmd <- glue::glue('cli::cli_{type}("{str}")')
    eval(parse(text=cmd))
  }
  if(return_str){
    invisible(str)  
  }
}

In the function above, return_message indicates whether the cli_X() function should be run and the return_str indicates whether the string should be returned (invisibly). You could then rewrite your function with the cli_wrapper() function:

my_function <- function(val, return_message = TRUE) {
  message <- NULL  
  if(val == 'a'){
    message <- c(message, cli_wrapper("your value {val} = a!", type="alert", val = val, return_message = return_messasge))
  }else{
    message <- c(message, cli_wrapper("your value {val} is not equal to a!", type="alert", val = val, return_message = return_messasge))
  }
  message <- c(message, cli_wrapper("processing now complete", type="h2", return_message = return_messasge))
  ret <- list(val=val, message = message)
  invisible(ret)
}

Running the function a couple of different ways would give the following output:

my_data <- my_function(val="x", return_message=TRUE)
# → your value x is not equal to a!
#   
#   ── processing now complete ──
# 

my_data
# $val
# [1] "x"
# 
# $message
# [1] "your value x is not equal to a!" "processing now complete"        
# 

my_data <- my_function(val="x", return_message=FALSE)

my_data
# $val
# [1] "x"
# 
# $message
# [1] "your value x is not equal to a!" "processing now complete"