From f783c8d62089fb23751c5ec2c886c5c162a9f92a Mon Sep 17 00:00:00 2001
From: mpadge <mark.padgham@email.com>
Date: Fri, 26 Aug 2022 12:22:28 +0200
Subject: [PATCH] add R/typetrace-package.R for #76

---
 DESCRIPTION           |  5 +++-
 R/typetrace-package.R | 68 +++++++++++++++++++++++++++++++++++++++++++
 codemeta.json         |  2 +-
 3 files changed, 73 insertions(+), 2 deletions(-)
 create mode 100644 R/typetrace-package.R

diff --git a/DESCRIPTION b/DESCRIPTION
index 4b058ee..225efcc 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: autotest
 Title: Automatic Package Testing
-Version: 0.0.2.195
+Version: 0.0.2.196
 Authors@R: c(
     person("Mark", "Padgham", , "mark.padgham@email.com", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0003-2172-5265")),
@@ -24,6 +24,7 @@ Imports:
     rlang,
     testthat,
     tibble,
+    typetracer,
     withr,
     yaml
 Suggests: 
@@ -38,6 +39,8 @@ Suggests:
     usethis
 VignetteBuilder: 
     knitr
+Remotes:
+    mpadge/typetracer
 Encoding: UTF-8
 Language: en-GB
 LazyData: true
diff --git a/R/typetrace-package.R b/R/typetrace-package.R
new file mode 100644
index 0000000..f39b263
--- /dev/null
+++ b/R/typetrace-package.R
@@ -0,0 +1,68 @@
+# Trace a package with 'typetracer'
+
+get_typetrace_dir <- function () {
+
+    td <- getOption ("typetracedir")
+    if (is.null (td)) {
+        td <- tempdir ()
+    }
+    return (td)
+}
+
+autotest_trace_package <- function (package) {
+
+    Sys.setenv ("TYPETRACER_LEAVE_TRACES" = "true")
+
+    package <- dot_to_package (package)
+    pkg_name <- preload_package (package)
+    if (pkg_name != package) {
+        if (!dir.exists (package)) {
+            stop ("'package' should be a local directory.")
+        }
+        traces <- typetracer::trace_package (pkg_dir = package)
+    } else {
+        traces <- typetracer::trace_package (package = package)
+    }
+
+    trace_files <- list.files (
+        get_typetrace_dir (),
+        pattern = "^typetrace\\_.*\\.Rds$",
+        full.names = TRUE
+    )
+
+    Sys.unsetenv ("TYPETRACER_LEAVE_TRACES")
+
+    return (trace_files)
+}
+
+#' Get all (unique) parameter names from all traced functions.
+#'
+#' @param traces Result of 'typetracer::trace_package()' call.
+#' @return Reduced version of 'traces' with only unique parameter names.
+#' @noRd
+get_unique_fn_pars <- function (traces) {
+
+    fn_pars <- unique (traces [, c ("fn_name", "par_name")])
+
+    par_types <- lapply (seq (nrow (fn_pars)), function (i) {
+        index <- which (traces$fn_name == fn_pars$fn_name [i] &
+                        traces$par_name == fn_pars$par_name [i])
+        onecol <- function (traces, index, what = "classes") {
+            res <- traces [[what]] [index]
+            if (is.list (res)) {
+                res <- do.call (c, res)
+            }
+            res <- unique (res)
+            paste0 (res [which (!res == "NULL")], collapse = ", ")
+        }
+        data.frame (
+            class = onecol (traces, index, "class"),
+            typeof = onecol (traces, index, "typeof"),
+            mode = onecol (traces, index, "mode"),
+            storage_mode = onecol (traces, index, "storage_mode"),
+            length = onecol (traces, index, "length")
+        )
+    })
+
+    return (cbind (fn_pars, do.call (rbind, par_types)))
+}
diff --git a/codemeta.json b/codemeta.json
index 8adbd4b..2e7e1ae 100644
--- a/codemeta.json
+++ b/codemeta.json
@@ -8,7 +8,7 @@
   "codeRepository": "https://github.com/ropensci-review-tools/autotest",
   "issueTracker": "https://github.com/ropensci-review-tools/autotest/issues",
   "license": "https://spdx.org/licenses/GPL-3.0",
-  "version": "0.0.2.195",
+  "version": "0.0.2.196",
   "programmingLanguage": {
     "@type": "ComputerLanguage",
     "name": "R",