Merge pull request #23 from mpadge/lists

read embedded list data on load_traces for #19

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: typetracer
 Title: Trace Function Parameter Types
-Version: 0.2.1.004
+Version: 0.2.1.009
 Authors@R: c(
     person("Mark", "Padgham", , "[email protected]", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0003-2172-5265")),

R/directory-fns.R

@@ -12,6 +12,19 @@ clear_fn_bodies_dir <- function () {
 
     fn_bodies_dir <- file.path (get_typetrace_dir (), "fn_bodies")
     if (dir.exists (fn_bodies_dir)) {
+        has_files <- length (list.files (fn_bodies_dir)) > 0L
+        if (has_files && interactive ()) {
+            chk <- readline (paste0 (
+                "All functions should first be uninjected before calling ",
+                "this function. Do you wish to continue (y/n)? "
+            ))
+            if (tolower (substring (chk, 1, 1)) != "y") {
+                stop (
+                    "Please call 'uninject_tracer(<fn_name>) first",
+                    call. = FALSE
+                )
+            }
+        }
         unlink (fn_bodies_dir, recursive = TRUE)
     }
 }

R/load-and-clear-traces.R

@@ -75,7 +75,7 @@ load_traces <- function (files = FALSE, quiet = FALSE) {
         call_envs$call_env <- paste0 (call_envs$namespace, "::", call_envs$name)
         call_envs$call_env [which (is.na (call_envs$name))] <- NA_character_
 
-        tibble::tibble (
+        out_i <- tibble::tibble (
             trace_name = i,
             trace_number = num_traces,
             trace_source = trace_source,
@@ -92,6 +92,40 @@ load_traces <- function (files = FALSE, quiet = FALSE) {
             uneval = par_uneval,
             eval = par_eval
         )
+
+        has_list <- integer (0L)
+        if (get_trace_lists_param ()) {
+            has_list <- which (vapply (
+                tr_i,
+                function (i) "list_data" %in% names (i),
+                logical (1L)
+            ))
+        }
+
+        if (length (has_list) > 0L) {
+
+            out_list_i <- lapply (tr_i [has_list], function (j) {
+                j_out <- do.call (rbind, lapply (j$list_data, as.data.frame))
+                j_out$par <- paste0 (j$par, "$", j_out$par)
+                return (j_out)
+            })
+            out_list_i <- do.call (rbind, out_list_i)
+            names (out_list_i) [names (out_list_i) == "par"] <- "par_name"
+            names (out_list_i) [names (out_list_i) == "par_uneval"] <- "uneval"
+            names (out_list_i) [names (out_list_i) == "par_eval"] <- "eval"
+
+            out_list <- out_i [integer (0L), ]
+            out_list <- out_list [seq_len (nrow (out_list_i)), ]
+            index <- match (names (out_list_i), names (out_list))
+            out_list [, index] <- out_list_i
+            index1 <- which (!names (out_list) %in% names (out_list_i))
+            index2 <- match (names (out_list) [index1], names (out_i))
+            out_list [, index1] <- out_i [seq_len (nrow (out_list_i)), index2]
+
+            out_i <- rbind (out_i, out_list)
+        }
+
+        return (out_i)
     })
 
     out <- do.call (rbind, out)

R/trace-package.R

@@ -2,14 +2,18 @@
 #' Trace all parameters for all functions in a specified package
 #'
 #' @param package Name of package to be traced (as character value).
+#' @param pkg_dir For "types" including "tests", a local directory to the source
+#' code of the package. (This is needed because installed versions do not
+#' generally include tests.)
 #' @param functions Optional character vector of names of functions to trace.
 #' Defaults to tracing all functions.
 #' @param types The types of code to be run to generate traces: one or both
 #' values of "examples" or "tests" (as for `tools::testInstalledPackage`). Note
 #' that only tests run via the \pkg{testthat} package can be traced.
-#' @param pkg_dir For "types" including "tests", a local directory to the source
-#' code of the package. (This is needed because installed versions do not
-#' generally include tests.)
+#' @param trace_lists If `TRUE`, trace into any nested list parameters
+#' (including `data.frame`-type objects), and return type information on each
+#' list component. The parameter names for these list-components are then
+#' specified in "dollar-notation", as '<par>$<item>', for example 'Orange$age'.
 #' @return A `data.frame` of data on every parameter of every function as
 #' specified in code provided in package examples.
 #' @export
@@ -19,13 +23,15 @@
 #' res <- trace_package (pkg_dir = "/<path>/<to>/<local>/<pacakge>")
 #' }
 trace_package <- function (package = NULL,
+                           pkg_dir = NULL,
                            functions = NULL,
                            types = c ("examples", "tests"),
-                           pkg_dir = NULL) {
+                           trace_lists = FALSE) {
 
     types <- match.arg (types, c ("examples", "tests"),
         several.ok = TRUE
     )
+    set_trace_list_option (trace_lists)
 
     package <- assert_trace_package_inputs (package, types, pkg_dir)
     pkg_was_attached <- any (grepl (paste0 ("package:", package), search ()))
@@ -53,6 +59,9 @@ trace_package <- function (package = NULL,
     if (is.null (trace_fns)) {
         trace_fns <- ls (p, all.names = TRUE)
     }
+
+    clear_traces ()
+
     pkg_env <- as.environment (p)
     for (fnm in trace_fns) {
         f <- get (fnm, envir = pkg_env)
@@ -61,8 +70,6 @@ trace_package <- function (package = NULL,
         }
     }
 
-    clear_traces ()
-
     traces_ex <- NULL
 
     if ("examples" %in% types) {
@@ -109,19 +116,18 @@ trace_package <- function (package = NULL,
         traces$trace_name <- traces$trace_source <- NULL
     }
 
-    # Envvar to enable traces to remain so that package can be used by
-    # 'autotest', through loading traces after calling 'trace_package()'
-    if (!Sys.getenv ("TYPETRACER_LEAVE_TRACES") == "true") {
-        clear_traces ()
-    }
-
     for (f in trace_fns) {
         f <- get (f, envir = pkg_env)
         if (is.function (f)) {
             uninject_tracer (f)
         }
     }
-    clear_fn_bodies_dir ()
+
+    # Envvar to enable traces to remain so that package can be used by
+    # 'autotest', through loading traces after calling 'trace_package()'
+    if (!Sys.getenv ("TYPETRACER_LEAVE_TRACES") == "true") {
+        clear_traces ()
+    }
 
     tryCatch (
         unloadNamespace (package),

R/tracer-define.R

@@ -53,9 +53,13 @@ typetracer_header <- function () {
         utils::getFromNamespace ("trace_one_param", "typetracer")
     typetracer_env$trace_one_list <-
         utils::getFromNamespace ("trace_one_list", "typetracer")
+    typetracer_env$get_trace_lists_param <-
+        utils::getFromNamespace ("get_trace_lists_param", "typetracer")
+
     typetracer_env$data <- lapply (typetracer_env$par_names, function (p) {
         dat_i <- typetracer_env$trace_one_param (typetracer_env, p, fn_env)
-        if (dat_i$typeof == "list") {
+        trace_lists <- typetracer_env$get_trace_lists_param ()
+        if (dat_i$typeof == "list" && trace_lists) {
             dat_i$list_data <-
                 typetracer_env$trace_one_list (typetracer_env, p, fn_env)
         }
@@ -179,6 +183,15 @@ trace_one_list <- function (typetracer_env, p, fn_env) {
         get (p, envir = fn_env, inherits = FALSE),
         error = function (e) NULL
     )
+
+    # non-standard evaluation, which is also necessary for lists passed as
+    # `...`:
+    if (is.null (res)) {
+        res <- tryCatch (
+            eval (typetracer_env$pars [[p]], envir = fn_env),
+            error = function (e) NULL
+        )
+    }
     if (is.null (res)) {
         return (res)
     }

R/tracer-inject.R

@@ -3,6 +3,7 @@
 #'
 #' @param f A function (that is, an object of class "function", and not a
 #' character string).
+#' @inheritParams trace_package
 #' @return Nothing (will error on fail).
 #'
 #' @note The tracer is defined in the internal `typetracer_header()` function.
@@ -23,9 +24,10 @@
 #' uninject_tracer (f)
 #' # Traces may also be removed:
 #' clear_traces ()
-inject_tracer <- function (f) {
+inject_tracer <- function (f, trace_lists = FALSE) {
 
     checkmate::assert_function (f)
+    set_trace_list_option (trace_lists)
 
     # save body for re-injection:
     f_name <- deparse (substitute (f))

R/utils.R

@@ -36,3 +36,17 @@ get_pkg_lib_path <- function (package, lib_paths) {
 
     return (lib_path)
 }
+
+set_trace_list_option <- function (trace_lists) {
+
+    options (typetracer_trace_lists = trace_lists)
+}
+
+get_trace_lists_param <- function () {
+
+    op <- options ("typetracer_trace_lists") [[1]]
+    if (length (op) == 0L) {
+        op <- FALSE
+    }
+    return (op)
+}

R/zzz.R

@@ -9,6 +9,7 @@
 .onUnload <- function (libname, pkgname) { # nolint
 
     options ("typetracedir" = NULL)
+    options ("typetrace_trace_lists" = NULL)
     f <- file.path (tempdir (), "fn_bodies")
     if (dir.exists (f)) {
         unlink (f, recursive = TRUE)

README.Rmd

@@ -165,12 +165,54 @@ For the function, `r`, above, this simply requires,
 uninject_tracer (f)
 ```
 
+All traces can also be removed with this functions:
+
+```{r}
+clear_traces ()
+```
+
+
 Because `typetracer` modifies the internal code of functions as defined within
 a current R session, we strongly recommend restarting your R session after
 using `typetracer`, to ensure expected function behaviour is restored.
 
 
-## Example #2 - Tracing a Package
+## Example #2 - Recursion into lists
+
+R has extensive support for list structures, notably including all
+`data.frame`-like objects in which each column is actually a list item.
+`typetracer` also offers the ability to recurse into the list structures of
+individual parameters, to recursively trace the properties of each list item.
+To do this, the traces themselves have to be injected with the additional
+parameter, `trace_lists = TRUE`.
+
+
+The final call above included an additional parameter passed as a list. The
+following code re-injects a tracer with the ability to traverse into list
+structures:
+
+```{r}
+inject_tracer (f, trace_lists = TRUE)
+val <- f (
+    x = 1:2,
+    y = 3:4 + 0.,
+    a = "blah",
+    b = list (a = 1, b = "b"),
+    f = a ~ b
+)
+x_lists <- load_traces ()
+print (x_lists)
+```
+
+And that result now has `r nrow(x_lists)` rows, or
+`r nrow(x_lists) - nrow(x)` more than the previous example, reflecting the two
+items passed as a `list` to the parameter, `b`. List-parameter items are
+identifiable in typetracer output through the "dollar-notation" in the
+`par_name` field. The final two values in the above table are `b$a` and `b$b`,
+representing the two elements of the list passed as the parameter, `b`.
+
+
+## Example #3 - Tracing a Package
 
 This section presents a more complex example tracing all function calls from
 [the `rematch` package](https://github.com/MangoTheCat/rematch), chosen because
@@ -183,6 +225,9 @@ function within the package, so there is no need to explicitly call [the
 `inject_tracer()`
 function](https://mpadge.github.io/typetracer/reference/inject_tracer).
 
+(This function also includes a `trace_lists` parameter, as demonstrated above,
+with a default of `FALSE` to not recurse into tracing list structures.)
+
 ```{r trace-rematch, message = FALSE}
 res <- trace_package ("rematch")
 res
@@ -227,7 +272,7 @@ from the ["testthat" package](https://testthat.r-lib.org). These calling
 environments are useful to discern whether, for example, a call was made with
 an expectation that it should error.
 
-### Example #2(a) - Specifying Functions to Trace
+### Example #3(a) - Specifying Functions to Trace
 
 [The `trace_package()`
 function](https://mpadge.github.io/typetracer/reference/trace_package.html)