Merge pull request #494 from ropensci/drake_plan_class

Use an S3 "drake_plan" class

NAMESPACE

@@ -1,9 +1,14 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method("[",drake_plan)
+S3method(as_drake_plan,data.frame)
+S3method(as_drake_plan,list)
+S3method(as_drake_plan,tbl_df)
 export(Makefile_recipe)
 export(analyses)
 export(analysis_wildcard)
 export(as_drake_filename)
+export(as_drake_plan)
 export(as_file)
 export(available_hash_algos)
 export(backend)
@@ -241,6 +246,7 @@ importFrom(testthat,expect_true)
 importFrom(testthat,test_dir)
 importFrom(testthat,test_that)
 importFrom(tibble,as_tibble)
+importFrom(tibble,new_tibble)
 importFrom(tibble,tibble)
 importFrom(tidyselect,contains)
 importFrom(tidyselect,ends_with)

R/drake_plan.R

@@ -566,29 +566,5 @@ target <- function(
         x
       }
     }) %>%
-    tibble::as_tibble()
-}
-
-# For pretty printing
-drake_plan_call <- function(plan){
-  target_calls <- purrr::pmap(plan, drake_target_call) %>%
-    setNames(plan$target)
-  as.call(c(quote(drake_plan), target_calls))
-}
-
-drake_target_call <- function(...){
-  args <- list(...)[drake_plan_columns()] %>%
-    select_valid()
-  target <- parse(text = args$target)[[1]]
-  args$target <- NULL
-  if (!is.null(args$command) && is.character(args$command)){
-    args$command <- parse(text = args$command)[[1]]
-  }
-  if (!is.null(args$trigger) && is.character(args$trigger)){
-    args$trigger <- parse(text = args$trigger)[[1]]
-  }
-  if (!identical(names(args), "command")){
-    args$command <- as.call(c(quote(target), args))
-  }
-  args$command
+    as_drake_plan()
 }

R/drake_plan_class.R

@@ -0,0 +1,37 @@
+#' @title Mark a data frame as a `drake` workflow plan
+#' @description Used for pretty printing only (coming soon).
+#'   You do not actually have to mark plans as such.
+#'   You can keep them as ordinary data frames.
+#' @export
+#' @keywords internal
+#' @param x object to mark as a `drake` plan
+#' @param ... other arguments to the method
+#' @examples
+#' plan <- list(target = "x", command = "get_data()")
+#' class(plan)
+#' plan <- as_drake_plan(plan)
+#' class(plan)
+as_drake_plan <- function(x, ...){
+  UseMethod("as_drake_plan")
+}
+
+as_drake_plan_ <- function(x, ...){
+  tibble::new_tibble(x, ..., subclass = "drake_plan")
+}
+
+#' @export
+`[.drake_plan` <- function(...){
+  as_drake_plan_(NextMethod())
+}
+
+#' @export
+#' @rdname as_drake_plan
+as_drake_plan.data.frame <- as_drake_plan_
+
+#' @export
+#' @rdname as_drake_plan
+as_drake_plan.list <- as_drake_plan_
+
+#' @export
+#' @rdname as_drake_plan
+as_drake_plan.tbl_df <- as_drake_plan_

R/drake_plan_print.R

@@ -0,0 +1,22 @@
+drake_plan_call <- function(plan){
+  target_calls <- purrr::pmap(plan, drake_target_call) %>%
+    setNames(plan$target)
+  as.call(c(quote(drake_plan), target_calls))
+}
+
+drake_target_call <- function(...){
+  args <- list(...)[drake_plan_columns()] %>%
+    select_valid()
+  target <- parse(text = args$target)[[1]]
+  args$target <- NULL
+  if (!is.null(args$command) && is.character(args$command)){
+    args$command <- parse(text = args$command)[[1]]
+  }
+  if (!is.null(args$trigger) && is.character(args$trigger)){
+    args$trigger <- parse(text = args$trigger)[[1]]
+  }
+  if (!identical(names(args), "command")){
+    args$command <- as.call(c(quote(target), args))
+  }
+  args$command
+}

R/generate_plans.R

@@ -164,7 +164,7 @@ evaluate_plan <- function(
       columns = columns
     )
   } else {
-    plan
+    as_drake_plan(plan)
   }
 }
 
@@ -248,7 +248,7 @@ evaluate_wildcard_rules <- function(
       columns = columns
     )
   }
-  plan
+  as_drake_plan(plan)
 }
 
 check_wildcard_rules <- function(rules){
@@ -302,7 +302,7 @@ check_wildcard_rules <- function(rules){
 #' expand_plan(datasets, values = 1:3, rename = FALSE)
 expand_plan <- function(plan, values = NULL, rename = TRUE){
   if (!length(values)){
-    return(plan)
+    return(as_drake_plan(plan))
   }
   nrows <- nrow(plan)
   repeat_targets <- rep(seq_len(nrows), each = length(values))
@@ -352,7 +352,8 @@ gather_plan <- function(
   command <- paste(plan$target, "=", plan$target)
   command <- paste(command, collapse = ", ")
   command <- paste0(gather, "(", command, ")")
-  tibble(target = target, command = command)
+  tibble(target = target, command = command) %>%
+    as_drake_plan()
 }
 
 #' @title Write commands to reduce several targets down to one.
@@ -413,15 +414,17 @@ reduce_plan <- function(
     tibble(
       target = pairs$names,
       command = paste0(begin, pairs$odds, op, pairs$evens, end)
-    )
+    ) %>%
+      as_drake_plan()
   } else {
     command <- Reduce(
       x = plan$target,
       f = function(x, y){
         paste0(begin, x, op, y, end)
       }
     )
-    tibble(target = target, command = command)
+    tibble(target = target, command = command) %>%
+      as_drake_plan()
   }
 }
 
@@ -594,9 +597,10 @@ plan_summaries <- function(
       )
     })
   target <- command <- NULL
-  bind_rows(gathered, out) %>%
+  dplyr::bind_rows(gathered, out) %>%
     ungroup %>%
-    select(target, command)
+    select(target, command) %>%
+    as_drake_plan()
 }
 
 with_analyses_only <- function(plan){

R/mtcars_example.R

@@ -137,7 +137,7 @@ load_mtcars_example <- function(
 
   # Row order doesn't matter in the drake_plan my_plan.
   envir$my_plan <- rbind(report, datasets, analyses, results) %>%
-    tibble::as_tibble()
+    as_drake_plan()
 
   # Write the R Markdown source for a dynamic knitr report
   report <- system.file(

R/package.R

@@ -65,7 +65,7 @@
 #' @importFrom stringi stri_extract_all_regex
 #'   stri_split_fixed stri_trim_both
 #' @importFrom testthat context expect_false expect_true test_dir test_that
-#' @importFrom tibble as_tibble tibble
+#' @importFrom tibble as_tibble new_tibble tibble
 #' @importFrom tidyselect vars_select
 #' @importFrom utils capture.output compareVersion head installed.packages
 #'   packageVersion read.csv sessionInfo stack type.convert unzip write.table

R/sanitize.R

@@ -1,6 +1,6 @@
 sanitize_plan <- function(plan, allow_duplicated_targets = FALSE){
   wildcards <- attr(plan, "wildcards")
-  plan <- as_tibble(plan)
+  plan <- as_drake_plan(plan)
   for (field in drake_plan_non_factors()){
     if (!is.null(plan[[field]])){
       if (is.factor(plan[[field]])){

tests/testthat/test-plan.R

@@ -570,3 +570,11 @@ test_with_dir("drake_plan_call() produces the correct calls", {
   expected <- my_plan[, c("target", "command", "trigger")]
   expect_equal(new_plan, expected)
 })
+
+test_with_dir("drake_plan class", {
+  expect_true(inherits(as_drake_plan(list(a = 1, b = 2)), "drake_plan"))
+  expect_true(inherits(as_drake_plan(list(a = 1, b = 2)), "drake_plan"))
+  expect_true(inherits(as_drake_plan(list(a = 1, b = 2)), "drake_plan"))
+  load_mtcars_example()
+  expect_true(inherits(my_plan, "drake_plan"))
+})