Fix #942

NEWS.md

@@ -10,6 +10,7 @@
 
 ## Enhancements
 
+- In `drake_plan()`, interpret custom columns as non-language objects (#942).
 - Suggest and assert `clustermq` >= 0.8.8.
 - Log the target name in a special column in the console log file ([#909](https://github.com/ropensci/drake/issues/909)).
 - Rename the "memory" memory strategy to "preclean" (with deprecation; #917).

R/api-dsl.R

@@ -41,6 +41,7 @@ transform_plan <- function(
   max_expand = NULL,
   tidy_eval = TRUE
 ) {
+  force(envir)
   transform_plan_(
     plan = plan,
     envir = envir,
@@ -85,7 +86,7 @@ transform_plan_ <- function(
     }
   }
   if (sanitize) {
-    plan <- sanitize_plan(plan)
+    plan <- sanitize_plan(plan, envir = envir)
   }
   plan
 }

R/drake_plan.R

@@ -197,7 +197,7 @@ drake_plan <- function(
   targets <- names(commands)
   plan <- weak_tibble(target = targets)
   plan$command <- commands
-  plan <- parse_custom_plan_columns(plan)
+  plan <- parse_custom_plan_columns(plan, envir = envir)
   if (transform && ("transform" %in% colnames(plan))) {
     plan <- transform_plan_(
       plan = plan,
@@ -209,28 +209,25 @@ drake_plan <- function(
     )
   }
   if (tidy_eval) {
-    for (col in setdiff(colnames(plan), c("target", "transform"))) {
-      plan[[col]] <- tidyeval_exprs(plan[[col]], envir = envir)
-    }
+    plan <- tidyeval_cols(plan, envir = envir)
   }
-  sanitize_plan(plan)
+  sanitize_plan(plan, envir = envir)
 }
 
-parse_custom_plan_columns <- function(plan) {
+parse_custom_plan_columns <- function(plan, envir) {
   Sys.setenv("drake_target_silent" = "true")
   on.exit(Sys.setenv("drake_target_silent" = ""))
   splits <- split(plan, seq_len(nrow(plan)))
-  out <- lapply(splits, parse_custom_plan_row)
+  out <- lapply(splits, parse_custom_plan_row, envir = envir)
   out <- do.call(drake_bind_rows, out)
-  sanitize_plan(out)
 }
 
-parse_custom_plan_row <- function(row) {
+parse_custom_plan_row <- function(row, envir) {
   expr <- row$command
   if (!length(expr) || !is_target_call(expr[[1]])) {
     return(row)
   }
-  out <- eval(expr[[1]])
+  out <- eval(expr[[1]], envir = envir)
   out$target <- row$target
   out
 }
@@ -270,7 +267,15 @@ fill_cols <- function(x, cols) {
   x
 }
 
-sanitize_plan <- function(plan, allow_duplicated_targets = FALSE) {
+sanitize_plan <- function(
+  plan,
+  allow_duplicated_targets = FALSE,
+  envir = parent.frame()
+) {
+  if (nrow(plan) < 1L) {
+    return(plan)
+  }
+  force(envir)
   fields <- intersect(colnames(plan), c("command", "target", "trigger"))
   for (field in fields) {
     if (!is.null(plan[[field]])) {
@@ -288,14 +293,8 @@ sanitize_plan <- function(plan, allow_duplicated_targets = FALSE) {
     plan <- assert_unique_targets(plan[, cols])
   }
   plan <- arrange_plan_cols(plan)
-  for (col in lang_cols(plan)) {
-    if (!is.list(plan[[col]])) {
-      plan[[col]] <- lapply(plan[[col]], safe_parse)
-    }
-  }
-  for (col in setdiff(colnames(plan), c("target", "command", "trigger"))) {
-    plan[[col]] <- unlist(plan[[col]])
-  }
+  plan <- eval_non_lang_cols(plan, envir = envir)
+  plan <- parse_lang_cols(plan)
   as_drake_plan(plan)
 }
 
@@ -382,6 +381,13 @@ empty_plan <- function() {
   out
 }
 
+tidyeval_cols <- function(plan, envir) {
+  for (col in setdiff(colnames(plan), c("target", "transform"))) {
+    plan[[col]] <- tidyeval_exprs(plan[[col]], envir = envir)
+  }
+  plan
+}
+
 tidyeval_exprs <- function(expr_list, envir) {
   lapply(expr_list, tidyeval_expr, envir = envir)
 }
@@ -391,6 +397,32 @@ tidyeval_expr <- function(expr, envir) {
   eval(call, envir = envir)
 }
 
+eval_non_lang_cols <- function(plan, envir) {
+  for (col in non_lang_cols(plan)) {
+    plan[[col]] <- eval_non_lang_col(plan[[col]], envir = envir)
+  }
+  plan
+}
+
+eval_non_lang_col <- function(x, envir) {
+  if (is.language(x[[1]])) {
+    x <- lapply(x, eval, envir = envir)
+  }
+  if (is.atomic(x[[1]])) {
+    x <- unlist(x)
+  }
+  x
+}
+
+parse_lang_cols <- function(plan) {
+  for (col in lang_cols(plan)) {
+    if (!is.list(plan[[col]])) {
+      plan[[col]] <- lapply(plan[[col]], safe_parse)
+    }
+  }
+  plan
+}
+
 # weak_as_tibble - use as_tibble() if available but fall back to
 # as.data.frame() if necessary
 weak_as_tibble <- function(..., .force_df = FALSE) {
@@ -406,7 +438,6 @@ weak_as_tibble <- function(..., .force_df = FALSE) {
 # data.frame() if necessary
 weak_tibble <- function(..., .force_df = FALSE) {
   no_tibble <- !suppressWarnings(requireNamespace("tibble", quietly = TRUE))
-
   if (.force_df || no_tibble) {
     data.frame(..., stringsAsFactors = FALSE)
   } else {
@@ -496,13 +527,9 @@ deparse_lang_col <- function(x) {
 }
 
 lang_cols <- function(plan) {
-  out <- intersect(colnames(plan), c("command", "trigger", "transform"))
-  others <- vapply(
-    plan,
-    function(x) {
-      as.logical(length(x)) && is.list(x) && is.language(x[[1]])
-    },
-    FUN.VALUE = logical(1)
-  )
-  union(out, names(which(others)))
+  intersect(colnames(plan), c("command", "trigger", "transform"))
+}
+
+non_lang_cols <- function(plan) {
+  setdiff(colnames(plan), c("command", "trigger", "transform"))
 }

R/drake_plan_keywords.R

@@ -40,13 +40,13 @@ target <- function(command = NULL, ...) {
   lst <- select_nonempty(lst)
   lst <- lst[nzchar(names(lst))]
   lst <- c(command = call$command, lst)
-  lst <- lapply(lst, function(x) {
-    if (is.language(x)) x <- list(x)
-    x
-  })
   out <- data.frame(command = NA, stringsAsFactors = FALSE)
   for (col in names(lst)) {
-    out[[col]] <- lst[[col]]
+    if (is.language(lst[[col]])) {
+      out[[col]] <- list(lst[[col]])
+    } else {
+      out[[col]] <- lst[[col]]
+    }
   }
   out
 }

R/preprocess-config.R

@@ -568,10 +568,10 @@ drake_config <- function(
       # 2019-06-22 # nolint
     )
   }
-  plan <- sanitize_plan(plan)
+  force(envir)
+  plan <- sanitize_plan(plan, envir = envir)
   plan_checks(plan)
   targets <- sanitize_targets(targets, plan)
-  force(envir)
   trigger <- convert_old_trigger(trigger)
   sleep <- `environment<-`(sleep, new.env(parent = globalenv()))
   if (is.null(cache)) {