Refactor cedta() for readability

R/cedta.R

@@ -1,4 +1,3 @@
-
 cedta.pkgEvalsUserCode = c("gWidgetsWWW","statET","FastRWeb","slidify","rmarkdown","knitr","ezknitr","IRkernel", "rtvs")
 # These packages run user code in their own environment and thus do not
 # themselves Depend or Import data.table. knitr's eval is passed envir=globalenv() so doesn't
@@ -26,12 +25,10 @@ cedta.pkgEvalsUserCode = c("gWidgetsWWW","statET","FastRWeb","slidify","rmarkdow
 
 # nocov start: very hard to reach this within our test suite -- the call stack within a call generated by e.g. knitr
 # for loop, not any(vapply_1b(.)), to allow early exit
-.any_eval_calls_in_stack = function() {
-  calls = sys.calls()
+.any_eval_calls_in_stack = function(calls) {
   # likelier to be close to the end of the call stack, right?
   for (ii in length(calls):1) { # nolint: seq_linter. rev(seq_len(length(calls)))? See https://bugs.r-project.org/show_bug.cgi?id=18406.
-    the_call = calls[[ii]][[1L]]
-    if (is.name(the_call) && (the_call %chin% c("eval", "evalq"))) return(TRUE)
+    if (calls[[ii]] %iscall% c("eval", "evalq")) return(TRUE)
   }
   FALSE
 }
@@ -47,6 +44,42 @@ cedta.pkgEvalsUserCode = c("gWidgetsWWW","statET","FastRWeb","slidify","rmarkdow
   FALSE
 }
 
+# in a helper to promote readability
+# NB: put the most common and recommended cases first for speed
+.cedta_impl_ <- function(ns, n) {
+  if (!isNamespace(ns)) {
+    # e.g. DT queries at the prompt (.GlobalEnv) and knitr's eval(,envir=globalenv()) but not DF[...] inside knitr::kable v1.6
+    return(TRUE)
+  }
+
+  nsname = getNamespaceName(ns)
+  if (nsname == "data.table") return(TRUE)
+
+  if ("data.table" %chin% names(getNamespaceImports(ns))) return(TRUE) # nocov
+
+  if (isTRUE(ns$.datatable.aware)) return(TRUE) # nocov
+
+  sc <- sys.calls()
+  if (nsname == "utils") {
+    if (exists("debugger.look", parent.frame(n+1L))) return(TRUE) # nocov
+
+    # 'example' for #2972
+    if (length(sc) >= 8L && sc[[length(sc) - 7L]] %iscall% 'example') return(TRUE) # nocov
+  }
+
+  if (nsname == "base") {
+    if (all(c("FUN", "X") %chin% ls(parent.frame(n)))) return(TRUE) # lapply
+
+    if (.any_sd_queries_in_stack(sc)) return(TRUE) # e.g. lapply() where "piped-in" j= arg has .SD[]
+  }
+
+  if (nsname %chin% cedta.pkgEvalsUserCode && .any_eval_calls_in_stack(sc)) return(TRUE) # nocov
+
+  # both ns$.Depends and get(.Depends,ns) are not sufficient
+  pkg_ns = paste("package", nsname, sep=":")
+  tryCatch("data.table" %chin% get(".Depends", pkg_ns, inherits=FALSE), error=function(e) FALSE)
+}
+
 # cedta = Calling Environment Data.Table-Aware
 cedta = function(n=2L) {
   # Calling Environment Data Table Aware
@@ -55,26 +88,10 @@ cedta = function(n=2L) {
     return(env$.datatable.aware)
   }
   ns = topenv(env)
-  if (!isNamespace(ns)) {
-    # e.g. DT queries at the prompt (.GlobalEnv) and knitr's eval(,envir=globalenv()) but not DF[...] inside knitr::kable v1.6
-    return(TRUE)
-  }
-  nsname = getNamespaceName(ns)
-  sc = sys.calls()
-  ans = nsname=="data.table" ||
-    "data.table" %chin% names(getNamespaceImports(ns)) ||   # most common and recommended cases first for speed
-    (nsname=="utils" &&
-      (exists("debugger.look", parent.frame(n+1L)) ||
-      (length(sc)>=8L && sc[[length(sc)-7L]] %iscall% 'example')) ) || # 'example' for #2972
-    (nsname=="base" && # lapply
-      (all(c("FUN", "X") %chin% ls(parent.frame(n))) ||
-      .any_sd_queries_in_stack(sc))) ||
-    (nsname %chin% cedta.pkgEvalsUserCode && .any_eval_calls_in_stack()) ||
-    isTRUE(ns$.datatable.aware) ||  # As of Sep 2018: RCAS, caretEnsemble, dtplyr, rstanarm, rbokeh, CEMiTool, rqdatatable, RImmPort, BPRMeth, rlist
-    tryCatch("data.table" %chin% get(".Depends",paste("package",nsname,sep=":"),inherits=FALSE),error=function(e)FALSE)  # both ns$.Depends and get(.Depends,ns) are not sufficient
+  ans = .cedta_impl_(ns, n+1L)
   if (!ans && getOption("datatable.verbose")) {
     # nocov start
-    catf("cedta decided '%s' wasn't data.table aware. Here is call stack with [[1L]] applied:\n", nsname)
+    catf("cedta decided '%s' wasn't data.table aware. Here is call stack with [[1L]] applied:\n", getNamespaceName(ns))
     print(sapply(sys.calls(), `[[`, 1L))
     # nocov end
     # so we can trace the namespace name that may need to be added (very unusually)