Merge pull request #19 from brownag/default_opt

Add geotargets options functions, with defaults for raster GDAL driver and creation options

DESCRIPTION

@@ -32,6 +32,7 @@ Language: en-GB
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.3.1
 Imports: 
+    rlang,
     targets,
     terra
 Suggests: 

NAMESPACE

@@ -1,5 +1,9 @@
 # Generated by roxygen2: do not edit by hand
 
+export(geotargets_option_get)
+export(geotargets_option_set)
 export(tar_terra_rast)
 export(tar_terra_vect)
+importFrom(rlang,"%||%")
+importFrom(rlang,arg_match0)
 importFrom(utils,globalVariables)

R/AAAA.R

@@ -0,0 +1,10 @@
+geotargets.env <- new.env()
+
+geotargets_env <- function() {
+    geotargets.env
+}
+
+.onAttach <- function(lib, pkg) {
+    geotargets.env$geotargets.gdal.raster.creation_options <- "ENCODING=UTF-8"
+    geotargets.env$geotargets.gdal.raster.driver_name <- "GTiff"
+}

R/geotargets-option.R

@@ -0,0 +1,65 @@
+#' Get or Set geotargets Options
+#'
+#' Get or set behavior for geospatial data target stores using geotargets-specific global options.
+#'
+#' @param option_name Character. Option name. See Details.
+#'
+#' @details
+#'
+#' ## Available Options
+#'
+#'  - `"geotargets.gdal.raster.creation_options"` - set the GDAL creation options used when writing raster files to target store (default: `"ENCODING=UTF-8"`)
+#'
+#'  - `"geotargets.gdal.raster.driver_name"` - set the file type used for raster data in target store (default: `"GTiff"`)
+#'
+#'  Each option can be overridden with a system environment variable. Options include:
+#'
+#'   - `GEOTARGETS_GDAL_RASTER_CREATION_OPTIONS`
+#'   - `GEOTARGETS_GDAL_RASTER_DRIVER_NAME`
+#'
+#' @rdname geotargets-options
+#' @export
+geotargets_option_get <- function(option_name) {
+    if (!startsWith(option_name, "geotargets.")) {
+        option_name <- paste0("geotargets.", option_name)
+    }
+
+    option_value <- geotargets_env()[[option_name]]
+
+    get_option <- function(option_name, option_value, name){
+        getOption(option_name, default = option_value %||% name)
+    }
+
+    get_geotargets_gdal_raster_creation_options <- function(option_name, option_value) {
+        gdal_creation_options <- Sys.getenv(
+            x = "GEOTARGETS_GDAL_RASTER_CREATION_OPTIONS",
+            unset = get_option(option_name, option_value, "ENCODING=UTF-8")
+        )
+        the_option <- strsplit(gdal_creation_options, ";")[[1]]
+        the_option
+    }
+
+    get_geotargets_gdal_raster_driver_name <- function(option_name, option_value) {
+        Sys.getenv(
+            x = "GEOTARGETS_GDAL_RASTER_DRIVER_NAME",
+            unset = get_option(option_name, option_value, "GTiff")
+        )
+    }
+
+    switch(option_name,
+           "geotargets.gdal.raster.creation_options" =
+               get_geotargets_gdal_raster_creation_options(option_name, option_value),
+           "geotargets.gdal.raster.driver_name" =
+               get_geotargets_gdal_raster_driver_name(option_name, option_value)
+    )
+}
+
+#' @param option_value Value to assign to option `x`.
+#' @rdname geotargets-options
+#' @export
+geotargets_option_set <- function(option_name, option_value) {
+    if (!startsWith(option_name, "geotargets.")) {
+        option_name <- paste0("geotargets.", option_name)
+    }
+    geotargets.env[[option_name]] <- option_value
+}

R/tar-terra-rast.R

@@ -7,7 +7,7 @@
 #' @param ... Additional arguments not yet used
 #'
 #' @inheritParams targets::tar_target
-#'
+#' @importFrom rlang %||% arg_match0
 #' @seealso [targets::tar_target_raw()]
 #' @export
 #' @examples
@@ -63,14 +63,9 @@ tar_terra_rast <- function(name,
         tidy_eval = tidy_eval
     )
 
-    # could pull defaults from geotargets package options
-    if (is.null(filetype)) {
-        filetype <- "GTiff"
-    }
-
-    if (is.null(gdal)) {
-        gdal <- "ENCODING=UTF-8"
-    }
+    # if not specified by user, pull the corresponding geotargets option
+    filetype <- filetype %||% geotargets_option_get("raster.gdal_driver_name")
+    gdal <- gdal %||% geotargets_option_get("raster.gdal_creation_options")
 
     targets::tar_target_raw(
         name = name,
@@ -107,21 +102,24 @@ create_format_terra_raster <- function(filetype, gdal, ...) {
     drv <- terra::gdal(drivers = TRUE)
     drv <- drv[drv$type == "raster" & grepl("write", drv$can), ]
 
-    if (is.null(filetype)) {
-        filetype <- "GTiff"
-    }
+    filetype <- filetype %||% geotargets_option_get("gdal.raster.driver_name")
+    filetype <- rlang::arg_match0(filetype, drv$name)
 
-    filetype <- match.arg(filetype, drv$name)
+    gdal <- gdal %||% geotargets_option_get("gdal.raster.creation_options")
 
+    # NOTE: Option getting functions are set in the .write_terra_raster function template
+    #       to resolve issue with body<- not working in some evaluation contexts ({covr}).
+    # TODO: It should be fine to have filetype and gdal as NULL
     .write_terra_raster <- function(object, path) {
         terra::writeRaster(
             object,
             path,
-            filetype = NULL,
+            filetype = geotargets::geotargets_option_get("gdal.raster.driver_name"),
             overwrite = TRUE,
-            gdal = NULL
+            gdal = geotargets::geotargets_option_get("gdal.raster.creation_options")
         )
     }
+
     body(.write_terra_raster)[[2]][["filetype"]] <- filetype
     body(.write_terra_raster)[[2]][["gdal"]] <- gdal
 

tests/testthat/test-tar-terra.R

@@ -1,5 +1,6 @@
 # test_that() #Included to make RStudio recognize this file as a test
 targets::tar_test("tar_terra_rast() works", {
+  geotargets::geotargets_option_set("raster_gdal_creation_options", c("COMPRESS=DEFLATE", "TFW=YES"))
   targets::tar_script({
     list(
       geotargets::tar_terra_rast(