test tar_workspace_download()

Author: wlandau

Diff for: R/class_builder.R

@@ -419,8 +419,7 @@ builder_save_workspace <- function(target, pipeline, scheduler, meta) {
     path_store = meta$store
   )
   scheduler$reporter$report_workspace(target)
-  meta$database$upload_workspace(target, meta)
-  scheduler$reporter$report_workspace_upload(target)
+  meta$database$upload_workspace(target, meta, scheduler$reporter)
 }
 
 builder_record_error_meta <- function(target, pipeline, meta) {

Diff for: R/class_database.R

@@ -435,7 +435,7 @@ database_class <- R6::R6Class(
       }
       "upload"
     },
-    upload_workspace = function(target, meta) {
+    upload_workspace = function(target, meta, reporter) {
       "upload_workspace"
     },
     download = function(verbose = TRUE) {
@@ -444,7 +444,7 @@ database_class <- R6::R6Class(
       }
       "download"
     },
-    download_workspace = function(name, store) {
+    download_workspace = function(name, store, verbose = TRUE) {
       "download_workspace"
     },
     head = function() {

Diff for: R/class_database_aws.R

@@ -67,10 +67,18 @@ database_aws_class <- R6::R6Class(
       )
       invisible()
     },
-    download_workspace = function(name, store) {
+    download_workspace = function(name, store, verbose = TRUE) {
       path <- path_workspace(store, name)
       key <- path_workspace(dirname(self$key), name)
       aws <- self$resources$aws
+      if (verbose) {
+        tar_print(
+          "Downloading AWS workspace file ",
+          key,
+          " to local file ",
+          path
+        )
+      }
       dir_create(dirname(path))
       aws_s3_download(
         file = path,
@@ -112,7 +120,7 @@ database_aws_class <- R6::R6Class(
       )
       invisible()
     },
-    upload_workspace = function(target, meta) {
+    upload_workspace = function(target, meta, reporter) {
       name <- target_get_name(target)
       path <- path_workspace(meta$store, name)
       key <- path_workspace(dirname(self$key), name)
@@ -127,6 +135,7 @@ database_aws_class <- R6::R6Class(
         args = aws$args,
         max_tries = aws$max_tries %|||% 5L
       )
+      reporter$report_workspace_upload(target)
       invisible()
     },
     head = function() {

Diff for: R/class_database_local.R

@@ -37,12 +37,21 @@ database_local_class <- R6::R6Class(
       }
       invisible()
     },
+    upload_workspace = function(target, meta, reporter) {
+      invisible()
+    },
     download = function(verbose = TRUE) {
       if (verbose) {
         tar_print(self$path, " not configured to download from the cloud.")
       }
       invisible()
     },
+    download_workspace = function(name, store, verbose = TRUE) {
+      if (verbose) {
+        tar_print(self$path, " not configured to download from the cloud.")
+      }
+      invisible()
+    },
     delete_cloud = function(verbose = TRUE) {
       if (verbose) {
         tar_print("Not configured to delete cloud object ", self$key)

Diff for: R/tar_workspace_download.R

@@ -17,6 +17,8 @@
 #'   defining the pipeline. Must be configured with the right `aws`
 #'   and `repository_meta` options (in [tar_option_set()])
 #'   to support downloading workspaces from the cloud.
+#' @param verbose `TRUE` to print an informative message describing the
+#'   download, `FALSE` to stay silent.
 #' @examples
 #' if (identical(Sys.getenv("TAR_EXAMPLES"), "true")) { # for CRAN
 #' tar_dir({ # tar_dir() runs code from a temp dir for CRAN.
@@ -54,7 +56,8 @@
 tar_workspace_download <- function(
   name,
   script = targets::tar_config_get("script"),
-  store = targets::tar_config_get("store")
+  store = targets::tar_config_get("store"),
+  verbose = TRUE
 ) {
   name <- tar_deparse_language(substitute(name))
   tar_assert_chr(name)
@@ -80,6 +83,10 @@ tar_workspace_download <- function(
       "tar_option_get(\"repository_meta\") == \"local\"."
     )
   )
-  database_meta(path_store = store)$download_workspace(name, store)
+  # Tested in tests/aws/test-aws-workspaces.R.
+  # nocov start
+  database <- database_meta(path_store = store)
+  database$download_workspace(name, store = store, verbose = verbose)
   invisible()
+  # nocov end
 }

Diff for: man/tar_workspace_download.Rd

@@ -423,7 +423,9 @@ tar_test("compare_working_directories()", {
 tar_test("local database cloud methods", {
   database <- database_init(repository = "local")
   expect_null(database$download())
+  expect_null(database$download_workspace(NULL, NULL, TRUE))
   expect_null(database$upload())
+  expect_null(database$upload_workspace(NULL, NULL, TRUE))
   expect_false(database$head()$exists)
   expect_null(database$delete_cloud())
 })
@@ -438,11 +440,13 @@ tar_test("database unknown repository", {
 tar_test("mock download",  {
   x <- database_class$new(path = tempfile())
   expect_equal(x$download(), "download")
+  expect_equal(x$download_workspace(), "download_workspace")
 })
 
 tar_test("mock upload",  {
   x <- database_class$new(path = tempfile())
   expect_equal(x$upload(), "upload")
+  expect_equal(x$upload_workspace(), "upload_workspace")
 })
 
 tar_test("mock head non-existent file",  {

Diff for: tests/testthat/test-class_database.R

@@ -10,6 +10,7 @@ tar_test("reporter abstract class", {
   expect_null(x$report_outdated(NULL))
   expect_null(x$report_outdated_end(NULL))
   expect_null(x$report_workspace(NULL))
+  expect_null(x$report_workspace_upload(NULL))
   expect_null(x$report_retry())
   expect_null(x$report_finalize())
   expect_null(x$flush_messages())

Diff for: tests/testthat/test-class_reporter.R

@@ -17,6 +17,20 @@ tar_test("run timestamp reporter with a error and saved workspace", {
   expect_error(expect_message(local$run()), class = "tar_condition_run")
 })
 
+tar_test("run timestamp reporter workspace upload", {
+  skip_on_os("windows")
+  pipeline <- pipeline_init(
+    list(
+      target_init("x", quote(123))
+    )
+  )
+  local <- local_init(pipeline, reporter = "timestamp")
+  local$run()
+  expect_message(
+    local$scheduler$reporter$report_workspace_upload(pipeline$targets$x)
+  )
+})
+
 tar_test("run timestamp reporter with a warning", {
   pipeline <- pipeline_init(list(target_init("x", quote(warning(123)))))
   local <- local_init(pipeline, reporter = "timestamp")

Diff for: tests/testthat/test-class_timestamp.R

@@ -17,6 +17,20 @@ tar_test("run verbose reporter with a error and save workspace", {
   expect_error(expect_message(local$run()), class = "tar_condition_run")
 })
 
+tar_test("run verbose reporter workspace upload", {
+  skip_on_os("windows")
+  pipeline <- pipeline_init(
+    list(
+      target_init("x", quote(123))
+    )
+  )
+  local <- local_init(pipeline, reporter = "verbose")
+  local$run()
+  expect_message(
+    local$scheduler$reporter$report_workspace_upload(pipeline$targets$x)
+  )
+})
+
 tar_test("run verbose reporter with a warning", {
   pipeline <- pipeline_init(list(target_init("x", quote(warning(123)))))
   local <- local_init(pipeline, reporter = "verbose")

Diff for: tests/testthat/test-class_verbose.R

@@ -0,0 +1,8 @@
+tar_test("tar_workspace_download() on a local pipeline", {
+  tar_script(tar_target(x, 1))
+  tar_make(callr_function = NULL)
+  expect_error(
+    tar_workspace_download(x),
+    condition = "tar_condition_validate"
+  )
+})

Diff for: tests/testthat/test-tar_workspace_download.R

@@ -54,6 +54,11 @@ tar_test("cli_workspace()", {
   expect_message(cli_workspace("x", time_stamp = TRUE))
 })
 
+tar_test("cli_workspace_upload()", {
+  skip_cran()
+  expect_message(cli_workspace_upload("x", time_stamp = TRUE))
+})
+
 tar_test("cli_blue_bullet()", {
   skip_cran()
   expect_message(cli_blue_bullet("x"))