add 'trace_one_list' fn to trace header for #19

mpadge · Jun 23, 2023 · d17d10b · d17d10b
1 parent a37c26b
commit d17d10b
Show file tree

Hide file tree

Showing 4 changed files with 49 additions and 4 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: typetracer
 Title: Trace Function Parameter Types
-Version: 0.2.1.003
+Version: 0.2.1.004
 Authors@R: c(
     person("Mark", "Padgham", , "[email protected]", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0003-2172-5265")),

diff --git a/R/tracer-define.R b/R/tracer-define.R
@@ -51,8 +51,15 @@ typetracer_header <- function () {
         utils::getFromNamespace ("get_param_str", "typetracer")
     typetracer_env$trace_one_param <-
         utils::getFromNamespace ("trace_one_param", "typetracer")
+    typetracer_env$trace_one_list <-
+        utils::getFromNamespace ("trace_one_list", "typetracer")
     typetracer_env$data <- lapply (typetracer_env$par_names, function (p) {
-        typetracer_env$trace_one_param (typetracer_env, p, fn_env)
+        dat_i <- typetracer_env$trace_one_param (typetracer_env, p, fn_env)
+        if (dat_i$typeof == "list") {
+            dat_i$list_data <-
+                typetracer_env$trace_one_list (typetracer_env, p, fn_env)
+        }
+        return (dat_i)
     })
 
     typetracer_env$process_back_trace <-
@@ -162,6 +169,36 @@ trace_one_param <- function (typetracer_env, p, fn_env) {
     )
 }
 
+#' Recurse into one list-type parameter to extract internal structure.
+#'
+#' Standard evaluation only!
+#' @noRd
+trace_one_list <- function (typetracer_env, p, fn_env) {
+
+    res <- tryCatch (
+        get (p, envir = fn_env, inherits = FALSE),
+        error = function (e) NULL
+    )
+    if (is.null (res)) {
+        return (res)
+    }
+
+    list_str <- lapply (seq_along (res), function (i) {
+        list (
+            par = names (res) [i],
+            class = class (res [[i]]),
+            typeof = typeof (res [[i]]),
+            storage_mode = storage.mode (res [[i]]),
+            mode = mode (res [[i]]),
+            length = length (res [[i]]),
+            par_uneval = NA_character_,
+            par_eval = NA_character_
+        )
+    })
+
+    return (list_str)
+}
+
 #' Extract environments of function calls
 #'
 #' Note that rlang enumerates envs from "0" for the calling environment. For

diff --git a/codemeta.json b/codemeta.json
@@ -11,7 +11,7 @@
   "codeRepository": "https://github.com/mpadge/typetracer",
   "issueTracker": "https://github.com/mpadge/typetracer/issues",
   "license": "https://spdx.org/licenses/MIT",
-  "version": "0.2.1.003",
+  "version": "0.2.1.004",
   "programmingLanguage": {
     "@type": "ComputerLanguage",
     "name": "R",

diff --git a/tests/testthat/_snaps/trace-fns.md b/tests/testthat/_snaps/trace-fns.md
@@ -27,8 +27,16 @@
               "typetracer")
           typetracer_env$trace_one_param <- utils::getFromNamespace("trace_one_param", 
               "typetracer")
+          typetracer_env$trace_one_list <- utils::getFromNamespace("trace_one_list", 
+              "typetracer")
           typetracer_env$data <- lapply(typetracer_env$par_names, function(p) {
-              typetracer_env$trace_one_param(typetracer_env, p, fn_env)
+              dat_i <- typetracer_env$trace_one_param(typetracer_env, 
+                  p, fn_env)
+              if (dat_i$typeof == "list") {
+                  dat_i$list_data <- typetracer_env$trace_one_list(typetracer_env, 
+                      p, fn_env)
+              }
+              return(dat_i)
           })
           typetracer_env$process_back_trace <- utils::getFromNamespace("process_back_trace", 
               "typetracer")