Sketch #519

DESCRIPTION

@@ -58,7 +58,6 @@ Authors@R: c(
 Depends:
   R (>= 3.3.0)
 Imports:
-  codetools,
   evaluate,
   digest,
   dplyr,

NAMESPACE

@@ -177,7 +177,6 @@ importFrom(R.utils,countLines)
 importFrom(R.utils,isPackageLoaded)
 importFrom(R.utils,withTimeout)
 importFrom(R6,R6Class)
-importFrom(codetools,findGlobals)
 importFrom(digest,digest)
 importFrom(dplyr,bind_rows)
 importFrom(dplyr,do)

R/build_drake_graph.R

@@ -52,7 +52,8 @@ build_drake_graph <- function(
     jobs = jobs,
     cache = cache,
     console_log_file = console_log_file,
-    trigger = parse_trigger(trigger = trigger, envir = envir)
+    trigger = parse_trigger(trigger = trigger, envir = envir),
+    globals = sort(c(plan$target, ls(envir = envir, all.names = TRUE)))
   )
   imports <- bdg_prepare_imports(config)
   import_deps <- memo_expr(
@@ -149,7 +150,11 @@ bdg_analyze_imports <- function(config, imports){
   lightly_parallelize(
     X = seq_along(imports),
     FUN = function(i){
-      import_dependencies(expr = imports[[i]], exclude = names(imports)[[i]])
+      import_dependencies(
+        expr = imports[[i]],
+        exclude = names(imports)[[i]],
+        globals = config$globals
+      )
     },
     jobs = config$jobs
   ) %>%
@@ -168,7 +173,8 @@ bdg_analyze_commands <- function(config){
     FUN = function(i){
       command_dependencies(
         command = config$plan$command[i],
-        exclude = config$plan$target[i]
+        exclude = config$plan$target[i],
+        globals = config$globals
       )
     },
     jobs = config$jobs
@@ -204,7 +210,10 @@ bdg_get_triggers <- function(config){
 }
 
 bdg_get_condition_deps <- function(config, triggers){
-  default_condition_deps <- import_dependencies(config$trigger$condition)
+  default_condition_deps <- import_dependencies(
+    config$trigger$condition,
+    globals = config$globals
+  )
   if ("trigger" %in% colnames(config$plan)){
     console_preprocess(text = "analyze condition triggers", config = config)
     condition_deps <- lightly_parallelize(
@@ -213,7 +222,8 @@ bdg_get_condition_deps <- function(config, triggers){
         if (!safe_is_na(config$plan$trigger[i])){
           import_dependencies(
             expr = triggers[[i]]$condition,
-            exclude = config$plan$target[i]
+            exclude = config$plan$target[i],
+            globals = config$globals
           )
         } else {
           default_condition_deps
@@ -232,7 +242,10 @@ bdg_get_condition_deps <- function(config, triggers){
 }
 
 bdg_get_change_deps <- function(config, triggers){
-  default_change_deps <- import_dependencies(config$trigger$change)
+  default_change_deps <- import_dependencies(
+    config$trigger$change,
+    globals = config$globals
+  )
   if ("trigger" %in% colnames(config$plan)){
     console_preprocess(text = "analyze change triggers", config = config)
     change_deps <- lightly_parallelize(
@@ -241,7 +254,8 @@ bdg_get_change_deps <- function(config, triggers){
         if (!safe_is_na(config$plan$trigger[i])){
           import_dependencies(
             expr = triggers[[i]]$change,
-            exclude = config$plan$target[i]
+            exclude = config$plan$target[i],
+            globals = config$globals
           )
         } else {
           default_change_deps

R/dependencies.R

@@ -255,21 +255,29 @@ nonfile_target_dependencies <- function(targets, config, jobs = 1){
   intersect(out, config$plan$target)
 }
 
-import_dependencies <- function(expr, exclude = character(0)){
-  deps <- code_dependencies(expr, exclude = exclude)
+import_dependencies <- function(expr, exclude = character(0), globals = NULL){
+  deps <- code_dependencies(expr, exclude = exclude, globals = globals)
   # Imported functions can't have file_out() deps # nolint
   # or target dependencies from knitr code chunks.
   # However, file_in()s are totally fine. # nolint
   deps$file_out <- deps$strings <- NULL
   deps
 }
 
-command_dependencies <- function(command, exclude = character(0)){
+command_dependencies <- function(
+  command,
+  exclude = character(0),
+  globals = NULL
+){
   if (!length(command)){
     return()
   }
   command <- as.character(command)
-  deps <- code_dependencies(parse(text = command), exclude = exclude)
+  deps <- code_dependencies(
+    parse(text = command),
+    exclude = exclude,
+    globals = globals
+  )
   deps$strings <- NULL
 
   # TODO: this block can go away when `drake`
@@ -364,7 +372,7 @@ unwrap_function <- function(funct){
   funct
 }
 
-code_dependencies <- function(expr, exclude = character(0)){
+code_dependencies <- function(expr, exclude = character(0), globals = NULL){
   if (
     !is.function(expr) &&
     !is.expression(expr) &&
@@ -386,7 +394,8 @@ code_dependencies <- function(expr, exclude = character(0)){
       }
       walk(body(expr))
     } else if (is.name(expr)) {
-      new_globals <- setdiff(x = wide_deparse(expr), y = drake_fn_patterns)
+      new_globals <- setdiff(x = wide_deparse(expr), y = drake_fn_patterns) %>%
+        Filter(f = is_parsable)
       results$globals <<- c(results$globals, new_globals)
     } else if (is.character(expr)) {
       results$strings <<- c(results$strings, expr)
@@ -415,7 +424,9 @@ code_dependencies <- function(expr, exclude = character(0)){
     }
   }
   walk(expr)
-  results$globals <- intersect(results$globals, find_globals(expr))
+  if (!is.null(globals)){
+    results$globals <- intersect(results$globals, globals)
+  }
   if (length(exclude) > 0){
     results <- lapply(
       X = results,
@@ -427,29 +438,6 @@ code_dependencies <- function(expr, exclude = character(0)){
   results[purrr::map_int(results, length) > 0]
 }
 
-find_globals <- function(fun){
-  if (!is.function(fun)){
-    f <- function(){} # nolint
-    body(f) <- as.call(append(as.list(body(f)), fun))
-    fun <- f
-  }
-  if (typeof(fun) != "closure"){
-    return(character(0))
-  }
-  fun <- unwrap_function(fun)
-  # The tryCatch statement fixes a strange bug in codetools
-  # for R 3.3.3. I do not understand it.
-  tryCatch(
-    codetools::findGlobals(fun = fun, merge = TRUE),
-    error = function(e){
-      fun <- eval(parse(text = rlang::expr_text(fun))) # nocov
-      codetools::findGlobals(fun = fun, merge = TRUE)  # nocov
-    }
-  ) %>%
-    setdiff(y = c(drake_fn_patterns, ".")) %>%
-    Filter(f = is_parsable)
-}
-
 analyze_loadd <- function(expr){
   expr <- match.call(drake::loadd, as.call(expr))
   expr <- expr[-1]

R/envir.R

@@ -105,7 +105,7 @@ flexible_get <- function(target, envir) {
   lang <- parsed[[1]]
   is_namespaced <- length(lang) > 1
   if (!is_namespaced){
-    return(get(x = target, envir = envir))
+    return(get(x = target, envir = envir, inherits = FALSE))
   }
   stopifnot(deparse(lang[[1]]) %in% c("::", ":::"))
   pkg <- deparse(lang[[2]])

R/package.R

@@ -37,7 +37,6 @@
 #' })
 #' }
 #' @references <https://github.com/ropensci/drake>
-#' @importFrom codetools findGlobals
 #' @importFrom digest digest
 #' @importFrom dplyr bind_rows do group_by mutate n select ungroup
 #' @importFrom evaluate try_capture_stack