ropensci · wlandau · Apr 9, 2021 · Apr 8, 2021 · Apr 8, 2021 · Apr 8, 2021
diff --git a/.Rbuildignore b/.Rbuildignore
@@ -24,6 +24,7 @@
 ^_pkgdown\.yml$
 ^_targets$
 ^_targets\.R$
+^_targets\.yaml$
 ^docs$
 ^CODE_OF_CONDUCT.md$
 ^codemeta\.json$

diff --git a/.gitignore b/.gitignore
@@ -16,3 +16,4 @@ README.html
 paper.html
 .Rproj.user
 _packages.R
+_targets.yaml
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -59,7 +59,8 @@ Imports:
   tidyselect (>= 1.1.0),
   utils,
   vctrs (>= 0.2.4),
-  withr (>= 2.1.2)
+  withr (>= 2.1.2),
+  yaml (>= 2.2.1)
 Suggests:
   arrow (>= 3.0.0),
   aws.s3 (>= 0.3.21),

diff --git a/NAMESPACE b/NAMESPACE
@@ -95,6 +95,8 @@ S3method(store_new,qs)
 S3method(store_new,rds)
 S3method(store_new,torch)
 S3method(store_new,url)
+S3method(store_path_from_record,default)
+S3method(store_path_from_record,tar_external)
 S3method(store_produce_path,default)
 S3method(store_produce_path,tar_aws)
 S3method(store_produce_path,tar_store_file)
@@ -115,6 +117,8 @@ S3method(store_read_path,tar_rds)
 S3method(store_read_path,tar_store_file)
 S3method(store_read_path,tar_torch)
 S3method(store_read_path,tar_url)
+S3method(store_row_path,default)
+S3method(store_row_path,tar_external)
 S3method(store_serialize_object,default)
 S3method(store_serialize_object,tar_keras)
 S3method(store_serialize_object,tar_torch)
@@ -248,6 +252,8 @@ export(starts_with)
 export(tar_bind)
 export(tar_branches)
 export(tar_cancel)
+export(tar_config_get)
+export(tar_config_set)
 export(tar_cue)
 export(tar_deduplicate)
 export(tar_delete)
@@ -257,6 +263,7 @@ export(tar_destroy)
 export(tar_dir)
 export(tar_edit)
 export(tar_envir)
+export(tar_envvars)
 export(tar_exist_meta)
 export(tar_exist_objects)
 export(tar_exist_process)
@@ -371,3 +378,4 @@ importFrom(withr,local_envvar)
 importFrom(withr,local_options)
 importFrom(withr,with_dir)
 importFrom(withr,with_seed)
+importFrom(yaml,read_yaml)
diff --git a/NEWS.md b/NEWS.md
@@ -14,6 +14,8 @@
 * Add new "summary" and "about" views to `tar_watch()` (#382).
 * Implement `tar_poll()` to repeatedly poll runtime progress in the R console (#381). `tar_poll()` is a lightweight alternative to `tar_watch()`.
 * Change the color of the "dormant" status in the graph.
+* Add a `tar_envvar()` function to list values of special environment variables supported in `targets`. The help file explains each environment variable in detail.
+* Support extra project-level configuration settings with `_targets.yaml` (#297). New functions `tar_config_get()` and `tar_config_set()` interact with the `_targets.yaml` file. Currently only supports the `store` field to set the data store path to something other than `_targets/`.
 
 ## Performance
 

diff --git a/R/class_aws.R b/R/class_aws.R
@@ -1,17 +1,11 @@
-# Semi-automated tests of Amazon S3 integration live in tests/aws/. # nolint
-# These tests should not be fully automated because they
-# automatically create S3 buckets and upload data,
-# which could put an unexpected and unfair burden on
-# external contributors from the open source community.
-# nocov start
 #' @export
 store_produce_path.tar_aws <- function(store, name, object) {
   bucket <- store$resources$bucket
   assert_nonempty(bucket, "S3 bucket name cannot be empty.")
   assert_chr(bucket, "S3 bucket name must be character.")
   assert_scalar(bucket, "invalid S3 bucket name.")
   assert_nzchar(bucket, "invalid S3 bucket name.")
-  prefix <- store$resources$prefix %|||% path_objects_dir()
+  prefix <- store$resources$prefix %|||% path_objects_dir_cloud()
   assert_nonempty(prefix, "S3 object prefix cannot be empty.")
   assert_chr(prefix, "invalid S3 prefix.")
   assert_scalar(prefix, "invalid S3 prefix.")
@@ -20,6 +14,12 @@ store_produce_path.tar_aws <- function(store, name, object) {
   c(bucket, object)
 }
 
+# Semi-automated tests of Amazon S3 integration live in tests/aws/. # nolint
+# These tests should not be fully automated because they
+# automatically create S3 buckets and upload data,
+# which could put an unexpected and unfair burden on
+# external contributors from the open source community.
+# nocov start
 #' @export
 store_produce_stage.tar_aws <- function(store, name, object) {
   tempfile(pattern = name)

diff --git a/R/class_aws_feather.R b/R/class_aws_feather.R
@@ -8,7 +8,13 @@ aws_feather_new <- function(file = NULL, resources = NULL) {
   force(resources)
   enclass(
     environment(),
-    c("tar_aws_feather", "tar_aws", "tar_feather", "tar_store")
+    c(
+      "tar_aws_feather",
+      "tar_aws",
+      "tar_external",
+      "tar_feather",
+      "tar_store"
+    )
   )
 }
 

diff --git a/R/class_aws_file.R b/R/class_aws_file.R
@@ -8,7 +8,7 @@ aws_file_new <- function(file = NULL, resources = NULL) {
   force(resources)
   enclass(
     environment(),
-    c("tar_aws_file", "tar_aws", "tar_store_file", "tar_store")
+    c("tar_aws_file", "tar_aws", "tar_external", "tar_store_file", "tar_store")
   )
 }
 

diff --git a/R/class_aws_fst.R b/R/class_aws_fst.R
@@ -8,7 +8,7 @@ aws_fst_new <- function(file = NULL, resources = NULL) {
   force(resources)
   enclass(
     environment(),
-    c("tar_aws_fst", "tar_aws", "tar_fst", "tar_store")
+    c("tar_aws_fst", "tar_aws",  "tar_external", "tar_fst", "tar_store")
   )
 }
 

diff --git a/R/class_aws_fst_dt.R b/R/class_aws_fst_dt.R
@@ -11,6 +11,7 @@ aws_fst_dt_new <- function(file = NULL, resources = NULL) {
     c(
       "tar_aws_fst_dt",
       "tar_aws",
+      "tar_external",
       "tar_fst_dt",
       "tar_fst",
       "tar_store"

diff --git a/R/class_aws_fst_tbl.R b/R/class_aws_fst_tbl.R
@@ -11,6 +11,7 @@ aws_fst_tbl_new <- function(file = NULL, resources = NULL) {
     c(
       "tar_aws_fst_tbl",
       "tar_aws",
+      "tar_external",
       "tar_fst_tbl",
       "tar_fst",
       "tar_store"

diff --git a/R/class_aws_keras.R b/R/class_aws_keras.R
@@ -8,7 +8,7 @@ aws_keras_new <- function(file = NULL, resources = NULL) {
   force(resources)
   enclass(
     environment(),
-    c("tar_aws_keras", "tar_aws", "tar_keras", "tar_store")
+    c("tar_aws_keras", "tar_aws", "tar_external", "tar_keras", "tar_store")
   )
 }
 

diff --git a/R/class_aws_parquet.R b/R/class_aws_parquet.R
@@ -8,7 +8,7 @@ aws_parquet_new <- function(file = NULL, resources = NULL) {
   force(resources)
   enclass(
     environment(),
-    c("tar_aws_parquet", "tar_aws", "tar_parquet", "tar_store")
+    c("tar_aws_parquet", "tar_aws", "tar_external", "tar_parquet", "tar_store")
   )
 }
 

diff --git a/R/class_aws_qs.R b/R/class_aws_qs.R
@@ -8,7 +8,7 @@ aws_qs_new <- function(file = NULL, resources = NULL) {
   force(resources)
   enclass(
     environment(),
-    c("tar_aws_qs", "tar_aws", "tar_qs", "tar_store")
+    c("tar_aws_qs", "tar_aws", "tar_external", "tar_qs", "tar_store")
   )
 }
 

diff --git a/R/class_aws_rds.R b/R/class_aws_rds.R
@@ -8,7 +8,7 @@ aws_rds_new <- function(file = NULL, resources = NULL) {
   force(resources)
   enclass(
     environment(),
-    c("tar_aws_rds", "tar_aws", "tar_rds", "tar_store")
+    c("tar_aws_rds", "tar_aws", "tar_external", "tar_rds", "tar_store")
   )
 }
 

diff --git a/R/class_aws_torch.R b/R/class_aws_torch.R
@@ -8,7 +8,7 @@ aws_torch_new <- function(file = NULL, resources = NULL) {
   force(resources)
   enclass(
     environment(),
-    c("tar_aws_torch", "tar_aws", "tar_torch", "tar_store")
+    c("tar_aws_torch", "tar_aws", "tar_external", "tar_torch", "tar_store")
   )
 }
 

diff --git a/R/class_config.R b/R/class_config.R
@@ -0,0 +1,111 @@
+config_init <- function(path = tempfile()) {
+  config_new(path = path)
+}
+
+config_new <- function(
+  path = NULL,
+  data = NULL,
+  time = NULL,
+  lock = NULL
+) {
+  config_class$new(
+    path = path,
+    data = data,
+    time = time,
+    lock = lock
+  )
+}
+
+config_class <- R6::R6Class(
+  classname = "tar_config",
+  class = FALSE,
+  portable = FALSE,
+  cloneable = FALSE,
+  public = list(
+    path = NULL,
+    data = NULL,
+    time = NULL,
+    lock = NULL,
+    initialize = function(
+      path = NULL,
+      data = NULL,
+      time = NULL,
+      lock = NULL
+    ) {
+      self$path <- path
+      self$data <- data
+      self$time <- time
+      self$lock <- lock
+    },
+    set_lock = function() {
+      self$lock <- TRUE
+    },
+    unset_lock = function() {
+      self$lock <- FALSE
+    },
+    is_unlocked = function() {
+      !identical(self$lock, TRUE)
+    },
+    path_exists = function() {
+      file.exists(self$path)
+    },
+    produce_time = function() {
+      if_any(self$path_exists(), file.mtime(self$path), NULL)
+    },
+    read = function() {
+      as.list(yaml::read_yaml(self$path))
+    },
+    load = function() {
+      if (self$is_unlocked()) {
+        self$data <- self$read()
+        self$time <- self$produce_time()
+      }
+    },
+    write = function() {
+      if (self$is_unlocked()) {
+        tmp <- tempfile()
+        yaml::write_yaml(x = self$data, file = tmp)
+        file.rename(from = tmp, to = self$path)
+      }
+      invisible()
+    },
+    unload = function() {
+      if (self$is_unlocked()) {
+        self$data <- NULL
+        self$time <- NULL
+      }
+    },
+    update = function() {
+      if_any(self$path_exists(), self$load(), self$unload())
+    },
+    outdated = function() {
+      !identical(self$time, self$produce_time())
+    },
+    ensure = function() {
+      if (self$outdated()) {
+        self$update()
+      }
+    },
+    get_store = function() {
+      self$ensure()
+      self$data$store
+    },
+    set_store = function(store) {
+      self$ensure()
+      if (self$is_unlocked()) {
+        self$data$store <- store
+      }
+      self$write()
+    },
+    validate = function() {
+      assert_chr(self$path %|||% "")
+      assert_scalar(self$path %|||% "")
+      assert_list(self$data %|||% list())
+      if (!is.null(self$time)) {
+        assert_inherits(self$time, "POSIXct")
+      }
+    }
+  )
+)
+
+tar_config <- config_init(path = "_targets.yaml")
diff --git a/R/class_external.R b/R/class_external.R
@@ -0,0 +1,9 @@
+#' @export
+store_row_path.tar_external <- function(store) {
+  store$file$path
+}
+
+#' @export
+store_path_from_record.tar_external <- function(store, record) {
+  record$path
+}
diff --git a/R/class_meta.R b/R/class_meta.R
@@ -24,9 +24,7 @@ meta_class <- R6::R6Class(
       memory_get_object(self$depends, name)
     },
     get_record = function(name) {
-      row <- self$database$get_row(name)
-      row <- lapply(row, unlist)
-      do.call(record_init, row)
+      record_from_row(self$database$get_row(name))
     },
     set_record = function(record) {
       self$database$set_row(record_produce_row(record))

diff --git a/R/class_pipeline.R b/R/class_pipeline.R
@@ -237,7 +237,7 @@ pipeline_validate_conflicts <- function(pipeline) {
     ". Suppress this warning with Sys.setenv(TAR_WARN = \"false\") ",
     "in _targets.R."
   )
-  if (length(conflicts) && Sys.getenv("TAR_WARN") != "false") {
+  if (length(conflicts) && !identical(Sys.getenv("TAR_WARN"), "false")) {
     warn_validate(msg)
   }
 }

diff --git a/R/class_record.R b/R/class_record.R
@@ -100,7 +100,7 @@ record_produce_row <- function(record) {
     command = record$command,
     depend = record$depend,
     seed = record$seed,
-    path = list(record$path),
+    path = list(record_row_path(record)),
     time = record$time,
     size = record$size,
     bytes = record$bytes,
@@ -114,6 +114,18 @@ record_produce_row <- function(record) {
   )
 }
 
+record_row_path <- function(record) {
+  store <- store_init(record$format)
+  store$file$path <- record$path
+  store_row_path(store)
+}
+
+record_from_row <- function(row) {
+  record <- do.call(record_init, lapply(row, unlist))
+  record$path <- store_path_from_record(store_init(record$format), record)
+  record
+}
+
 record_encode_field <- function(field) {
   if (!length(field) || anyNA(field)) {
     return(NA_character_)

diff --git a/R/class_store.R b/R/class_store.R
@@ -80,6 +80,24 @@ store_produce_path.default <- function(store, name, object) {
   path_objects(name)
 }
 
+store_row_path <- function(store) {
+  UseMethod("store_row_path")
+}
+
+#' @export
+store_row_path.default <- function(store) {
+  NA_character_
+}
+
+store_path_from_record <- function(store, record) {
+  UseMethod("store_path_from_record")
+}
+
+#' @export
+store_path_from_record.default <- function(store, record) {
+  path_objects(record$name)
+}
+
 store_update_stage <- function(store, name, object) {
   store$file$stage <- store_produce_stage(store, name, object)
 }