Merge pull request #67 from njtierney/resources-fix

Pass user specified `resources`
njtierney · May 13, 2024 · 4af63c5 · 4af63c5
2 parents 31d7c6d + 51ca40b
commit 4af63c5
Show file tree

Hide file tree

Showing 6 changed files with 91 additions and 27 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -4,3 +4,4 @@
 * Created `tar_terra_sprc()` that creates a `SpatRasterCollection` object.
 * `geotargets_options_get()` and `geotargets_options_set()` can be used to set and get options specific to `geotargets`.
 * `geotargets` now requires `targets` version 1.7.0 or higher
+* fixed a bug where `resources` supplied to `tar_terra_*()` were being ignored (#66)
diff --git a/R/tar-terra-rast.R b/R/tar-terra-rast.R
@@ -57,6 +57,11 @@ tar_terra_rast <- function(name,
 
     check_pkg_installed("terra")
 
+    #ensure that user-passed `resources` doesn't include `custom_format`
+    if ("custom_format" %in% names(resources)) {
+        cli::cli_abort("{.val custom_format} cannot be supplied to targets created with {.fn tar_terra_rast}")
+    }
+
     name <- targets::tar_deparse_language(substitute(name))
 
     envir <- targets::tar_option_get("envir")
@@ -103,17 +108,18 @@ tar_terra_rast <- function(name,
         garbage_collection = garbage_collection,
         deployment = deployment,
         priority = priority,
-        resources = targets::tar_resources(
-            custom_format = targets::tar_resources_custom_format(
-                #these envvars are used in write function of format
-                envvars = c(
-                    "GEOTARGETS_GDAL_RASTER_DRIVER" = filetype,
-                    "GEOTARGETS_GDAL_RASTER_CREATION_OPTIONS" = (
-                        paste0(gdal, collapse = ";")
+        resources = utils::modifyList(
+            targets::tar_resources(
+                custom_format = targets::tar_resources_custom_format(
+                    #these envvars are used in write function of format
+                    envvars = c(
+                        "GEOTARGETS_GDAL_RASTER_DRIVER" = filetype,
+                        "GEOTARGETS_GDAL_RASTER_CREATION_OPTIONS" = (
+                            paste0(gdal, collapse = ";")
                         )
                     )
-            )
-        ),
+                )
+            ), resources),
         storage = storage,
         retrieval = retrieval,
         cue = cue

diff --git a/R/tar-terra-sprc.R b/R/tar-terra-sprc.R
@@ -62,6 +62,10 @@ tar_terra_sprc <- function(name,
                            retrieval = targets::tar_option_get("retrieval"),
                            cue = targets::tar_option_get("cue")) {
   check_pkg_installed("terra")
+    #ensure that user-passed `resources` doesn't include `custom_format`
+    if ("custom_format" %in% names(resources)) {
+        cli::cli_abort("{.val custom_format} cannot be supplied to targets created with {.fn tar_terra_sprc}")
+    }
 
   gdal <- gdal %||% character(0)
   filetype <- filetype %||% "GTiff"
@@ -123,17 +127,18 @@ tar_terra_sprc <- function(name,
     garbage_collection = garbage_collection,
     deployment = deployment,
     priority = priority,
-    resources = targets::tar_resources(
-        custom_format = targets::tar_resources_custom_format(
-            #these envvars are used in write function of format
-            envvars = c(
-                "GEOTARGETS_GDAL_RASTER_DRIVER" = filetype,
-                "GEOTARGETS_GDAL_RASTER_CREATION_OPTIONS" = (
-                    paste0(gdal, collapse = ";")
+    resources = utils::modifyList(
+        targets::tar_resources(
+            custom_format = targets::tar_resources_custom_format(
+                #these envvars are used in write function of format
+                envvars = c(
+                    "GEOTARGETS_GDAL_RASTER_DRIVER" = filetype,
+                    "GEOTARGETS_GDAL_RASTER_CREATION_OPTIONS" = (
+                        paste0(gdal, collapse = ";")
                     )
+                )
             )
-        )
-    ),
+        ), resources),
     storage = storage,
     retrieval = retrieval,
     cue = cue

diff --git a/R/tar-terra-vect.R b/R/tar-terra-vect.R
@@ -66,6 +66,11 @@ tar_terra_vect <- function(name,
 
     check_pkg_installed("terra")
 
+    #ensure that user-passed `resources` doesn't include `custom_format`
+    if ("custom_format" %in% names(resources)) {
+        cli::cli_abort("{.val custom_format} cannot be supplied to targets created with {.fn tar_terra_vect}")
+    }
+
     name <- targets::tar_deparse_language(substitute(name))
 
     envir <- targets::tar_option_get("envir")
@@ -102,17 +107,18 @@ tar_terra_vect <- function(name,
         garbage_collection = garbage_collection,
         deployment = deployment,
         priority = priority,
-        resources = targets::tar_resources(
-            custom_format = targets::tar_resources_custom_format(
-                #these envvars are used in write function of format
-                envvars = c(
-                    "GEOTARGETS_GDAL_VECTOR_DRIVER" = filetype,
-                    "GEOTARGETS_GDAL_VECTOR_CREATION_OPTIONS" = (
-                        paste0(gdal, collapse = ";")
+        resources = utils::modifyList(
+            targets::tar_resources(
+                custom_format = targets::tar_resources_custom_format(
+                    #these envvars are used in write function of format
+                    envvars = c(
+                        "GEOTARGETS_GDAL_VECTOR_DRIVER" = filetype,
+                        "GEOTARGETS_GDAL_VECTOR_CREATION_OPTIONS" = (
+                            paste0(gdal, collapse = ";")
                         )
+                    )
                 )
-            )
-        ),
+            ), resources),
         storage = storage,
         retrieval = retrieval,
         cue = cue

diff --git a/tests/testthat/test-geotargets-option.R b/tests/testthat/test-geotargets-option.R
@@ -18,14 +18,23 @@ targets::tar_test("geotargets_options_get() retrieves options in correct priorit
     )
 })
 
+
 test_that("geotargets_option_set() works", {
+    op <- getOption("geotargets.gdal.raster.driver")
+    withr::defer(options("geotargets.gdal.raster.driver" = op))
+
     geotargets_option_set(gdal_raster_driver = "COG")
     expect_equal(getOption("geotargets.gdal.raster.driver"), "COG")
     expect_equal(geotargets_option_get("gdal.raster.driver"), "COG")
     expect_equal(geotargets_option_get("gdal_raster_driver"), "COG")
 })
 
 test_that("options aren't reset with multiple calls to geotargets_option_set()", {
+    op_rast <- getOption("geotargets.gdal.raster.driver")
+    withr::defer(options("geotargets.gdal.raster.driver" = op_rast))
+    op_vect <- getOption("geotargets.gdal.vector.driver")
+    withr::defer(options("geotargets.gdal.vector.driver" = op_vect))
+
     geotargets_option_set(gdal_raster_driver = "GPKG")
     geotargets_option_set(gdal_vector_driver = "GPKG")
     expect_equal(geotargets_option_get("gdal_vector_driver"), "GPKG")

diff --git a/tests/testthat/test-tar-terra.R b/tests/testthat/test-tar-terra.R
@@ -1,4 +1,5 @@
 # test_that() #Included to make RStudio recognize this file as a test
+library(targets)
 targets::tar_test("tar_terra_rast() works", {
     # geotargets::geotargets_option_set(gdal_raster_creation_options = c("COMPRESS=DEFLATE", "TFW=YES"))
     targets::tar_script({
@@ -87,3 +88,39 @@ targets::tar_test("tar_terra_vect() works with multiple workers (tests marshalin
     expect_s4_class(targets::tar_read(vect1), "SpatVector")
 })
 
+targets::tar_test("user resources are passed correctly", {
+    library(crew)
+    persistent <- crew::crew_controller_local(name = "persistent")
+    transient  <- crew::crew_controller_local(name = "transient", tasks_max = 1L)
+    targets::tar_option_set(
+        controller = crew::crew_controller_group(persistent, transient),
+        resources = tar_resources(
+            crew = tar_resources_crew(controller = "transient")
+        ))
+    testthat::expect_equal(
+        tar_terra_rast(x, 1)$settings$resources$crew,
+        tar_resources_crew(controller = "transient")
+    )
+    testthat::expect_equal(
+        tar_terra_rast(
+            x, 1,
+            resources = tar_resources(crew = tar_resources_crew(controller = "persistent"))
+        )$settings$resources$crew,
+        tar_resources_crew(controller = "persistent")
+    )
+    testthat::expect_equal(
+        tar_terra_vect(
+            x, 1,
+            resources = tar_resources(crew = tar_resources_crew(controller = "persistent"))
+        )$settings$resources$crew,
+        tar_resources_crew(controller = "persistent")
+    )
+    testthat::expect_equal(
+        tar_terra_sprc(
+            x, 1,
+            resources = tar_resources(crew = tar_resources_crew(controller = "persistent"))
+        )$settings$resources$crew,
+        tar_resources_crew(controller = "persistent")
+    )
+})
+