tar_workspace_download()

wlandau · wlandau · commit 920beb2dc1d5 · 2025-02-04T11:19:00.000-05:00
diff --git a/NAMESPACE b/NAMESPACE
@@ -551,6 +551,7 @@ export(tar_watch_app_ui)
 export(tar_watch_server)
 export(tar_watch_ui)
 export(tar_workspace)
+export(tar_workspace_download)
 export(tar_workspaces)
 export(target_run_worker)
 export(use_targets)
diff --git a/R/class_builder.R b/R/class_builder.R
@@ -419,6 +419,8 @@ 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)
 }
 
 builder_record_error_meta <- function(target, pipeline, meta) {
diff --git a/R/class_database.R b/R/class_database.R
@@ -435,12 +435,18 @@ database_class <- R6::R6Class(
       }
       "upload"
     },
+    upload_workspace = function(target, meta) {
+      "upload_workspace"
+    },
     download = function(verbose = TRUE) {
       if (verbose) {
         tar_message_run("downloading")
       }
       "download"
     },
+    download_workspace = function(name, store) {
+      "download_workspace"
+    },
     head = function() {
       file <- file_init(path = "path_cloud")
       file_ensure_hash(file)
diff --git a/R/class_database_aws.R b/R/class_database_aws.R
@@ -67,6 +67,22 @@ database_aws_class <- R6::R6Class(
       )
       invisible()
     },
+    download_workspace = function(name, store) {
+      path <- path_workspace(store, name)
+      key <- path_workspace(dirname(self$key), name)
+      aws <- self$resources$aws
+      dir_create(dirname(path))
+      aws_s3_download(
+        file = path,
+        key = key,
+        bucket = aws$bucket,
+        region = aws$region,
+        endpoint = aws$endpoint,
+        args = aws$args,
+        max_tries = aws$max_tries %|||% 5L
+      )
+      invisible()
+    },
     upload = function(verbose = TRUE) {
       if (verbose) {
         tar_print(
@@ -96,6 +112,23 @@ database_aws_class <- R6::R6Class(
       )
       invisible()
     },
+    upload_workspace = function(target, meta) {
+      name <- target_get_name(target)
+      path <- path_workspace(meta$store, name)
+      key <- path_workspace(dirname(self$key), name)
+      aws <- self$resources$aws
+      aws_s3_upload(
+        file = path,
+        key = key,
+        bucket = aws$bucket,
+        region = aws$region,
+        endpoint = aws$endpoint,
+        part_size = aws$part_size,
+        args = aws$args,
+        max_tries = aws$max_tries %|||% 5L
+      )
+      invisible()
+    },
     head = function() {
       aws <- self$resources$aws
       head <- aws_s3_head(
diff --git a/R/class_reporter.R b/R/class_reporter.R
@@ -73,6 +73,8 @@ reporter_class <- R6::R6Class(
     },
     report_workspace = function(target) {
     },
+    report_workspace_upload = function(target) {
+    },
     report_retry = function(target = NULL, progress = NULL) {
     },
     report_finalize = function(progress = NULL) {
diff --git a/R/class_timestamp.R b/R/class_timestamp.R
@@ -80,6 +80,15 @@ timestamp_class <- R6::R6Class(
         )
       )
     },
+    report_workspace_upload = function(target) {
+      self$buffer_message(
+        cli_workspace_upload(
+          target_get_name(target),
+          time_stamp = TRUE,
+          print = FALSE
+        )
+      )
+    },
     report_retry = function(target, progress = NULL) {
       self$buffer_message(
         cli_retry(
diff --git a/R/class_verbose.R b/R/class_verbose.R
@@ -69,6 +69,11 @@ verbose_class <- R6::R6Class(
     report_workspace = function(target) {
       self$buffer_message(cli_workspace(target_get_name(target), print = FALSE))
     },
+    report_workspace_upload = function(target) {
+      self$buffer_message(
+        cli_workspace_upload(target_get_name(target), print = FALSE)
+      )
+    },
     report_retry = function(target, progress = NULL) {
       self$buffer_message(
         cli_retry(
diff --git a/R/tar_workspace.R b/R/tar_workspace.R
@@ -1,4 +1,4 @@
-#' @title Load a saved workspace and seed for debugging.
+#' @title Load a locally saved workspace and seed for debugging.
 #' @export
 #' @family debug
 #' @description Load the packages, environment, and random number generator
@@ -12,6 +12,13 @@
 #'   are still in the data store (usually files in `_targets/objects/`).
 #'   When you are done debugging, you can remove the workspace files
 #'   using `tar_destroy(destroy = "workspaces")`.
+#'
+#'   If `tar_option_get("repository_meta")` is `"aws"` or `"gcp"`, then
+#'   [tar_make()] uploads workspaces to the bucket and prefix provided.
+#'   Download one of these workspaces with [tar_workspace_download()].
+#'   Downloaded workspaces can be loaded the usual way with
+#'   [tar_workspace()], and you should see them in
+#'   character vector returned by [tar_workspaces()].
 #' @return This function returns `NULL`, but it does load
 #'   the target's required packages, as well as multiple objects
 #'   into the environment (`envir` argument) in order to replicate the
@@ -35,7 +42,6 @@
 #' tar_script({
 #'   library(targets)
 #'   library(tarchetypes)
-#'   tar_option_set(workspace_on_error = TRUE)
 #'   list(
 #'     tar_target(x, "loaded"),
 #'     tar_target(y, stop(x))
diff --git a/R/tar_workspace_download.R b/R/tar_workspace_download.R
@@ -0,0 +1,85 @@
+#' @title Download a workspace from the cloud.
+#' @export
+#' @family debug
+#' @description Download a workspace file from the cloud
+#'   so it can be loaded with [tar_workspace()].
+#' @details If `tar_option_get("repository_meta")` is `"aws"` or `"gcp"`, then
+#'   [tar_make()] uploads workspaces to the bucket and prefix provided.
+#'   Download one of these workspaces with [tar_workspace_download()].
+#'   Downloaded workspaces can be loaded the usual way with
+#'   [tar_workspace()], and you should see them in
+#'   character vector returned by [tar_workspaces()].
+#' @return `NULL` (invisibly). Returns an error if the workspace
+#'   cannot be downloaded.
+#' @inheritParams tar_validate
+#' @param name Symbol, name of the target whose workspace to download.
+#' @param script Character string, file path to the `_targets.R` file
+#'   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.
+#' @examples
+#' if (identical(Sys.getenv("TAR_EXAMPLES"), "true")) { # for CRAN
+#' tar_dir({ # tar_dir() runs code from a temp dir for CRAN.
+#' tmp <- sample(1)
+#' tar_script({
+#'   library(targets)
+#'   library(tarchetypes)
+#'   tar_option_set(
+#'   tar_option_set(
+#'     resources = tar_resources(
+#'       tar_resources_aws(
+#'         bucket = "YOUR_AWS_BUCKET",
+#'         prefix = "_targets"
+#'       )
+#'     ),
+#'     repository = "aws",
+#'     repository_meta = "aws"
+#'   )
+#'   f <- function() stop("this is an error and thus triggers a workspace")
+#'   list(
+#'     tar_target(x, f()),
+#'   )
+#' }, ask = FALSE)
+#' # The following code throws an error for demonstration purposes.
+#' try(tar_make())
+#' # Say the workspace file for target x does not exist.
+#' unlink("_targets/workspaces/x")
+#' file.exists("_targets/workspaces/x")
+#' # We can download it with tar_workspace_download()
+#' tar_workspace_download(x)
+#' file.exists("_targets/workspaces/x")
+#' tar_workspace(x)
+#' })
+#' }
+tar_workspace_download <- function(
+  name,
+  script = targets::tar_config_get("script"),
+  store = targets::tar_config_get("store")
+) {
+  name <- tar_deparse_language(substitute(name))
+  tar_assert_chr(name)
+  tar_assert_scalar(name)
+  tar_assert_nzchar(name)
+  tar_assert_scalar(store)
+  tar_assert_chr(store)
+  tar_assert_nzchar(store)
+  options <- tar_script_options(script = script)
+  old_repository_meta <- tar_options$get_repository_meta()
+  old_resources <- tar_options$get_resources()
+  on.exit({
+    tar_options$set_repository_meta(old_repository_meta)
+    tar_options$set_resources(old_resources)
+  })
+  tar_options$set_repository_meta(options$repository_meta)
+  tar_options$set_resources(options$resources)
+  tar_assert_not_in(
+    x = options$repository_meta,
+    choices = "local",
+    msg = paste(
+      "tar_workspace_download() is not supported for",
+      "tar_option_get(\"repository_meta\") == \"local\"."
+    )
+  )
+  database_meta(path_store = store)$download_workspace(name, store)
+  invisible()
+}
diff --git a/R/tar_workspaces.R b/R/tar_workspaces.R
@@ -1,8 +1,11 @@
-#' @title List saved target workspaces.
+#' @title List locally saved target workspaces.
 #' @export
 #' @family debug
 #' @description List target workspaces currently saved to
-#'   `_targets/workspaces/`. See [tar_workspace()] for more information.
+#'   `_targets/workspaces/` locally.
+#'   Does not include workspaces saved to the cloud.
+#'   See [tar_workspace()] and [tar_workspace_download()]
+#'   for more information.
 #' @return Character vector of available workspaces to load with
 #'   [tar_workspace()].
 #' @inheritParams tar_validate
diff --git a/R/utils_cli.R b/R/utils_cli.R
@@ -126,6 +126,12 @@ cli_workspace <- function(name, time_stamp = FALSE, print = TRUE) {
   cli_blue_play(msg, print = print)
 }
 
+cli_workspace_upload <- function(name, time_stamp = FALSE, print = TRUE) {
+  time <- if_any(time_stamp, time_stamp_cli(), NULL)
+  msg <- paste(c(time, "uploaded workspace", name), collapse = " ")
+  cli_blue_play(msg, print = print)
+}
+
 cli_retry <- function(name, prefix = NULL, time_stamp = FALSE, print = TRUE) {
   time <- if_any(time_stamp, time_stamp_cli(), NULL)
   msg <- paste(c(time, "retrying", prefix, name), collapse = " ")
diff --git a/_pkgdown.yml b/_pkgdown.yml
@@ -52,6 +52,7 @@ reference:
   - 'tar_load_globals'
   - 'tar_traceback'
   - 'tar_workspace'
+  - 'tar_workspace_download'
   - 'tar_workspaces'
 - title: Storage
   contents:
diff --git a/man/tar_load_globals.Rd b/man/tar_load_globals.Rd
diff --git a/man/tar_traceback.Rd b/man/tar_traceback.Rd
diff --git a/man/tar_workspace.Rd b/man/tar_workspace.Rd
diff --git a/man/tar_workspace_download.Rd b/man/tar_workspace_download.Rd
diff --git a/man/tar_workspaces.Rd b/man/tar_workspaces.Rd
diff --git a/tests/aws/test-aws-workspaces.R b/tests/aws/test-aws-workspaces.R

Original file line number	Diff line number	Diff line change
`@@ -419,6 +419,8 @@ builder_save_workspace <- function(target, pipeline, scheduler, meta) {`
`419`	`419`	`path_store = meta$store`
`420`	`420`	`)`
`421`	`421`	`scheduler$reporter$report_workspace(target)`
	`422`	`+ meta$database$upload_workspace(target, meta)`
	`423`	`+ scheduler$reporter$report_workspace_upload(target)`
`422`	`424`	`}`
`423`	`425`
`424`	`426`	`builder_record_error_meta <- function(target, pipeline, meta) {`