Feature/peeking

DESCRIPTION

@@ -23,8 +23,11 @@ BugReports: https://github.com/lewinfox/icecream/issues
 Imports: 
     cli,
     glue,
+    pillar (>= 1.6.1),
+    purrr (>= 0.3.4),
     rlang
 Suggests: 
+    checkmate (>= 2.0.0),
     testthat (>= 3.0.0),
     withr
 Config/testthat/edition: 3

NAMESPACE

@@ -1,10 +1,23 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(ic_autopeek,data.frame)
+S3method(ic_autopeek,default)
+S3method(ic_autopeek,list)
+S3method(ic_autopeek_header,data.frame)
+S3method(ic_autopeek_header,default)
+S3method(ic_autopeek_header,list)
 export(ic)
 export(ic_disable)
 export(ic_enable)
 importFrom(cli,cli_alert_info)
 importFrom(glue,glue)
+importFrom(glue,glue_collapse)
+importFrom(glue,single_quote)
+importFrom(pillar,obj_sum)
+importFrom(purrr,detect_index)
+importFrom(purrr,map2_chr)
+importFrom(purrr,map_chr)
+importFrom(purrr,map_int)
 importFrom(rlang,caller_env)
 importFrom(rlang,caller_fn)
 importFrom(rlang,enquo)

R/autopeek.R

@@ -0,0 +1,95 @@
+#' Get descriptive one-line summary of an object
+#'
+#' This function is created as a modification of [utils::str()] function. It is supposed to
+#' create more compacted yet informative summary about an object. It's default value of
+#' "icecream.peeking.function"
+#'
+#' @param object The object to be summarized.
+#' @param ... Other arguments passed to methods.
+#'
+#' @details This is a generic function. Default method simply calls `utils::str` function.
+#'
+#' @return The function is mainly used for its side effects -- outputting to the terminal.
+#' However, it also returns an invisible string of the printed summary.
+#'
+#' @seealso [utils::str()] [ic_peek()]
+ic_autopeek <- function(object, ...) UseMethod("ic_autopeek")
+
+#' @export
+ic_autopeek.default <- function(object, ...) {
+  str(object, ...)
+}
+
+#' @param max_summary_length Integer. Maximum length of string summarizing the object.
+#'
+#' @describeIn ic_autopeek Method for list
+#'
+#' @importFrom glue glue glue_collapse single_quote
+#' @importFrom purrr map2_chr map_chr map_int detect_index
+#' @importFrom pillar obj_sum
+#' @export
+ic_autopeek.list <- function(object,
+                             max_summary_length = 70,
+                             ...) {
+  # names of columns or their index if it does not exist
+  col_name <- if (is.null(names(object))) {
+    seq_along(object)
+  } else {
+    ifelse(
+      is.na(names(object)),
+      seq_along(object),
+      single_quote(names(object))
+    )
+  }
+
+  # short type summary as in pillar package
+  type_summary <- map_chr(object, obj_sum)
+
+  # combine name of column and type summary
+  col_summary <- glue("${col_name}: {type_summary}")
+
+  # get header of the summary
+  header <- ic_autopeek_header(object)
+
+  # calculate how many columns summaries can fit into the console
+  index <- detect_index(
+    cumsum(map_int(col_summary, nchar) + 2),
+    ~ . > max_summary_length - nchar(header) - 3
+  )
+
+  # paste summary of all columns
+  summary <- glue_collapse(
+    if (index == 0) col_summary else c(col_summary[seq_len(index - 1)], "..."),
+    sep = ", "
+  )
+
+  ret <- paste0(header, summary)
+  cat(ret)
+  invisible(ret)
+}
+
+#' @describeIn ic_autopeek Method for data.frame
+#' @export
+ic_autopeek.data.frame <- ic_autopeek.list
+
+#' Get a header of the object peeked at
+#'
+#' @param object The object peeked at.
+#' @param ... Other arguments passed to methods.
+#'
+#' @details This function is used by `ic_autopeek` to get a header of the summary of a object.
+#' It should return object's top-level class name and its dimension.
+#'
+ic_autopeek_header <- function(object, ...) UseMethod("ic_autopeek_header")
+
+#' @importFrom glue glue
+#' @export
+ic_autopeek_header.default <- function(object, ...) glue("{class(object)[[1]]}: ")
+
+#' @importFrom glue glue
+#' @export
+ic_autopeek_header.list <- function(object, ...) glue("{class(object)[[1]]} [{length(object)}]: ")
+
+#' @importFrom glue glue
+#' @export
+ic_autopeek_header.data.frame <- function(object, ...) glue("{class(object)[[1]]} [{nrow(object)} x {ncol(object)}]: ")

R/ic.R

@@ -11,7 +11,6 @@
 #' ic(f(1))
 #'
 #' ic(f(-1))
-#'
 #' @importFrom rlang enquo quo_is_missing trace_back quo_get_expr caller_fn caller_env expr_deparse eval_tidy fn_env env_label maybe_missing
 #' @importFrom glue glue
 #' @export
@@ -27,7 +26,7 @@ ic <- function(x) {
     trace <- trace_back()
     num_calls <- length(trace$calls)
 
-    parent_ref <-  if (num_calls > 1) trace$calls[[num_calls - 1]][[1]] else NULL
+    parent_ref <- if (num_calls > 1) trace$calls[[num_calls - 1]][[1]] else NULL
     ref <- attr(trace$calls[[num_calls]], "srcref")
     loc <- src_loc(ref)
 

R/icecream-package.R

@@ -14,6 +14,11 @@
 #'   complicated debugging but produces a lot of output so is disabled by default. When `ic()` is
 #'   called with no arguments, the context is always printed because showing the location of the
 #'   call is the only reason to call `ic()` on its own.
+#' * `icecream.peeking.function`: indicates the function that summarizes the object. Default value
+#'   is `ic_autopeek`, which works like `utils::str` for most of the time, but gives more
+#'   informative output for `lists`, `data.frames` and their subclasses in a more compact way.
+#' * `icecream.max.lines` Integer. Determines maximum number of lines that the peek of an object
+#'   occupies; defaults to 1.
 #' * `icecream.output.function`: Not implemented yet. See the
 #'   [configuration](https://github.com/gruns/icecream#configuration) section of the original
 #'   project docs for details of what it will do.

R/peek.R

@@ -0,0 +1,37 @@
+#' Peek at value of expression
+#'
+#' This function is a proxy for calling peeking function.
+#'
+#' @param value The result of evaluating an expression inside the `ic()` function.
+#' @param peeking_function The function used to peek at the value. Default value is set by the
+#' "icecream.peeking.function" option.
+#' @param max_lines Maximum number of lines printed. Default value is set by the
+#' "icecream.max.lines" option.
+#'
+#' @details Default value of `icecream.peeking.function` is `ic_autopeek`. Suggested possible
+#' alternatives are:
+#'
+#' * `utils::str`
+#' * `print`
+#' * `head`
+#' * `summary`
+#' * `tibble::glimpse`
+#'
+#' @return A string to be printed.
+#'
+#' @seealso [ic_autopeek()] [utils::str()] [base::print()] [utils::head()] [base::summary()]
+#' [tibble::glimpse()]
+#' @keywords internal
+#' @importFrom utils capture.output
+ic_peek <- function(value,
+                    peeking_function = getOption("icecream.peeking.function"),
+                    max_lines = getOption("icecream.max.lines")) {
+  output <- capture.output(peeking_function(value))
+  real_lines <- min(length(output), max_lines)
+  if (real_lines == 1) {
+    trimws(output[[1]])
+  } else {
+    output <- trimws(output[1:real_lines])
+    paste0(c("", output), collapse = "\n")
+  }
+}

R/print.R

@@ -35,26 +35,22 @@ ic_print <- function(loc, parent_ref, deparsed_expression = missing_arg(), value
   # Formatting result
   if (!is_missing(deparsed_expression)) {
     # We want to print a one-line summary for complex objects like lists and data frames.
-    #
-    # TODO: Taking the first line of output from `str()` is a quick way of getting this but it
-    #       doesn't produce great output (try passing in a `lm()` object - ugly). It would be nice
-    #       to fix this at some point.
-    str_res <- trimws(capture.output(str(value)))[[1]]
+    str_res <- ic_peek(value)
     expression_string <- glue("{{.var {deparsed_expression}}}: {str_res}")
   }
 
   # We need to check what options are set to decide what to print - whether to include the context
   # or not.
-  #
-  # TODO: Shall icecream.include.context be reanamed to something like
-  # icecream.always.include.context? This may be misleading as context is printed when no
-  # expression is evaluated regardless of option value
   prefix <- getOption("icecream.prefix", "ic|")
   output <- if (!is.null(expression_string)) {
     if (getOption("icecream.always.include.context")) {
       glue("{context_string} | {expression_string}")
-    } else expression_string
-  } else context_string
+    } else {
+      expression_string
+    }
+  } else {
+    context_string
+  }
   output <- paste(prefix, output)
 
   cli_alert_info(output)

R/zzz.R

@@ -4,6 +4,8 @@
     icecream.enabled = TRUE,
     icecream.prefix = "ic|",
     icecream.output.function = NULL,
+    icecream.peeking.function = ic_autopeek,
+    icecream.max.lines = 1,
     icecream.arg.to.string.function = NULL,
     icecream.always.include.context = FALSE
   )
@@ -15,6 +17,8 @@
     icecream.enabled = NULL,
     icecream.prefix = NULL,
     icecream.output.function = NULL,
+    icecream.peeking.function = NULL,
+    icecream.max.lines = NULL,
     icecream.arg.to.string.function = NULL,
     icecream.always.include.context = NULL
   )

README.Rmd

@@ -220,6 +220,37 @@ of the call is the only reason to call `ic()` on its own.
 options(icecream.always.include.context = old.ctx)
 ```
 
+### `icecream.peeking.function` and `icecream.max.lines`
+These two options control how the result of evaluation of an expression is printed. `icecream.peeking.function` indicates the function that summarizes the object. Default value is `ic_autopeek`, which works like `utils::str` for most of the time, but gives more informative output
+for `lists`, `data.frames` and their subclasses in a more compact way. `icecream.max.lines` 
+determines maximum number of lines that the peek of an object occupies; defaults to 1. 
+
+For more complex data you may want to use e.g. `head` function and 5 lines.
+
+```{r, include=FALSE}
+old.fun <- getOption("icecream.peeking.function")
+old.lines <- getOption("icecream.max.lines")
+```
+
+```{r, include=TRUE}
+data(iris)
+
+ic(iris) # we would like to see header of the data
+
+options(icecream.peeking.function = head,
+        icecream.max.lines = 5)
+
+ic(iris)
+```
+
+```{r, include=FALSE}
+options(icecream.peeking.function = old.fun,
+        icecream.max.lines = old.lines)
+```
+
+Note that if `icecream.max.lines` is greater than 1 and summary of an object is longer than 1, the 
+alert occupies one line more due to the header.
+
 ### `icecream.output.function`, `icecream.arg.to.string.function`
 Not implemented yet. See the [configuration](https://github.com/gruns/icecream#configuration)
 section of the original project docs for details of what they will do.