From 152b0c0356c0dfc4c6d933277d5b24f287d7d221 Mon Sep 17 00:00:00 2001
From: Beaudette <dylan.beaudette@usda.gov>
Date: Wed, 10 Jan 2024 21:53:57 -0800
Subject: [PATCH] use terra::metags for WCS metadata, keep track of vintage

---
 NAMESPACE            |  1 +
 R/ISSR800.R          |  9 ++++++---
 R/WCS-utils.R        |  6 ++++++
 R/mukey-WCS.R        | 22 +++++++++++++++-------
 R/soilColorWCS.R     | 14 +++++++++-----
 man/soilColor.wcs.Rd |  2 +-
 6 files changed, 38 insertions(+), 16 deletions(-)

diff --git a/NAMESPACE b/NAMESPACE
index 3211bc33..829884fc 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -205,6 +205,7 @@ importFrom(stats,complete.cases)
 importFrom(stats,na.omit)
 importFrom(stats,splinefun)
 importFrom(stats,weighted.mean)
+importFrom(terra,`metags<-`)
 importFrom(utils,URLencode)
 importFrom(utils,object.size)
 importFrom(utils,packageVersion)
diff --git a/R/ISSR800.R b/R/ISSR800.R
index 51a34cbd..2c213fe5 100644
--- a/R/ISSR800.R
+++ b/R/ISSR800.R
@@ -36,6 +36,9 @@
 #' @export
 ISSR800.wcs <- function(aoi, var, res = 800, quiet = FALSE) {
   
+  ## vintage of source data
+  .vintage <- 'FY2023'
+  
   if (!requireNamespace("terra")) {
     stop("package 'terra' is required", call. = FALSE)
   }
@@ -163,9 +166,6 @@ ISSR800.wcs <- function(aoi, var, res = 800, quiet = FALSE) {
   # set layer name in object
   names(r) <- var.spec$desc
   
-  # and as an attribute
-  attr(r, 'layer name') <- var.spec$desc
-  
   # optional processing of RAT
   if (!is.null(var.spec$rat)) {
     
@@ -212,6 +212,9 @@ ISSR800.wcs <- function(aoi, var, res = 800, quiet = FALSE) {
     }
   }
   
+  # set metadata
+  metags(r) <- c(description = var.spec$desc, vintage = .vintage)
+  
   return(r)
 }
 
diff --git a/R/WCS-utils.R b/R/WCS-utils.R
index d30d2b40..b446a8a1 100644
--- a/R/WCS-utils.R
+++ b/R/WCS-utils.R
@@ -660,6 +660,7 @@ WCS_details <- function(wcs = c('mukey', 'ISSR800', 'soilColor')) {
     dsn = 'gnatsgo',
     type = 'GEOTIFF_FLOAT',
     desc = 'gNATSGO map unit keys',
+    vintage = 'FY2024',
     na = 2147483647L,
     res = 30,
     rat = NULL
@@ -669,6 +670,7 @@ WCS_details <- function(wcs = c('mukey', 'ISSR800', 'soilColor')) {
     dsn = 'gssurgo',
     type = 'GEOTIFF_FLOAT',
     desc = 'gSSURGO map unit keys',
+    vintage = 'FY2024',
     na = 2147483647L,
     res = 30,
     rat = NULL
@@ -678,6 +680,7 @@ WCS_details <- function(wcs = c('mukey', 'ISSR800', 'soilColor')) {
     dsn = 'hi_ssurgo',
     type = 'GEOTIFF_FLOAT',
     desc = 'HI map unit keys',
+    vintage = 'FY2023',
     na = 4294967295,
     res = 30,
     rat = NULL
@@ -687,6 +690,7 @@ WCS_details <- function(wcs = c('mukey', 'ISSR800', 'soilColor')) {
     dsn = 'pr_ssurgo',
     type = 'GEOTIFF_FLOAT',
     desc = 'PR map unit keys',
+    vintage = 'FY2023',
     na = 4294967295,
     res = 30,
     rat = NULL
@@ -696,6 +700,7 @@ WCS_details <- function(wcs = c('mukey', 'ISSR800', 'soilColor')) {
     dsn = 'statsgo',
     type = 'GEOTIFF_FLOAT',
     desc = 'STATSGO2 map unit keys',
+    vintage = 'FY2023',
     na = 0L,
     res = 300,
     rat = NULL
@@ -705,6 +710,7 @@ WCS_details <- function(wcs = c('mukey', 'ISSR800', 'soilColor')) {
     dsn = 'rss',
     type = 'GEOTIFF_FLOAT',
     desc = 'RSS map unit keys',
+    vintage = 'FY2023',
     na = 0L,
     res = 10,
     rat = NULL
diff --git a/R/mukey-WCS.R b/R/mukey-WCS.R
index 83a612f7..56bc4675 100644
--- a/R/mukey-WCS.R
+++ b/R/mukey-WCS.R
@@ -219,10 +219,18 @@ mukey.wcs <- function(aoi, db = c('gNATSGO', 'gSSURGO', 'RSS', 'STATSGO', 'PR_SS
   
   ## TODO: is this needed? (yes, still needed; AGB 2023/09/30)
   ## '0' is returned by the WCS sometimes -- never valid for MUKEY
-  r <- terra::classify(r, matrix(c(0,  var.spec$na,
-                                   NA, var.spec$na,
-                                   NaN, var.spec$na), ncol = 2, byrow = TRUE), include.lowest = TRUE)
-
+  r <- terra::classify(
+    r, 
+    matrix(
+      c(0,  var.spec$na,
+        NA, var.spec$na,
+        NaN, var.spec$na), 
+      ncol = 2, 
+      byrow = TRUE
+    ), 
+    include.lowest = TRUE
+  )
+  
   # load all values into memory
   terra::set.values(r)
   
@@ -240,9 +248,6 @@ mukey.wcs <- function(aoi, db = c('gNATSGO', 'gSSURGO', 'RSS', 'STATSGO', 'PR_SS
   
   # build RAT
   r <- terra::as.factor(r)
-  
-  # and as an attribute
-  attr(r, 'layer name') <- var.spec$desc
 
   input_class <- attr(wcs.geom, '.input_class')
   
@@ -257,6 +262,9 @@ mukey.wcs <- function(aoi, db = c('gNATSGO', 'gSSURGO', 'RSS', 'STATSGO', 'PR_SS
     }
   }
   
+  # set metadata
+  metags(r) <- c(description = var.spec$desc, vintage = var.spec$vintage)
+  
   return(r)
 }
 
diff --git a/R/soilColorWCS.R b/R/soilColorWCS.R
index 6eaad545..ffb5f9fa 100644
--- a/R/soilColorWCS.R
+++ b/R/soilColorWCS.R
@@ -25,7 +25,7 @@
 #' Variables available from this WCS can be queried using \code{WCS_details(wcs = 'soilColor')}. The full resolution version of the soil color grids use a `hr` suffix, e.g. 'sc025cm_hr'.
 #' 
 #' 
-#' @return A SpatRaster (or RasterLayer) object containing indexed map unit keys and associated raster attribute table or a try-error if request fails. By default, spatial classes from the `terra` package are returned. If the input object class is from the `raster` or `sp` packages a RasterLayer is returned.
+#' @return A `SpatRaster` (or `RasterLayer`) object containing indexed map unit keys and associated raster attribute table or a try-error if request fails. By default, spatial classes from the `terra` package are returned. If the input object class is from the `raster` or `sp` packages a `RasterLayer` is returned.
 #' 
 #' @examples 
 #' \dontrun{
@@ -43,9 +43,13 @@
 #' plot(res, col = cats(res)[[1]]$col, axes = FALSE, legend = FALSE)
 #' }
 #' @export
+#' @importFrom terra `metags<-`
 soilColor.wcs <- function(aoi, var, res = 270, quiet = FALSE) {
   
-  # sanity check: aoi specification
+  ## vintage of source data
+  .vintage <- 'FY2023'
+  
+  # sanity check: AOI specification
   if (!inherits(aoi, c('list', 'Spatial', 'sf', 'sfc', 'bbox', 'RasterLayer', 'SpatRaster', 'SpatVector'))) { 
     stop('invalid `aoi` specification', call. = FALSE)
   }
@@ -157,9 +161,6 @@ soilColor.wcs <- function(aoi, var, res = 270, quiet = FALSE) {
   # set layer name in object
   names(r) <- var.spec$desc
   
-  # and as an attribute
-  attr(r, 'layer name') <- var.spec$desc
-  
   # optional processing of RAT
   if (!is.null(var.spec$rat)) {
     
@@ -204,6 +205,9 @@ soilColor.wcs <- function(aoi, var, res = 270, quiet = FALSE) {
     }
   }
   
+  # set metadata
+  metags(r) <- c(description = var.spec$desc, vintage = .vintage)
+  
   return(r)
 }
 
diff --git a/man/soilColor.wcs.Rd b/man/soilColor.wcs.Rd
index d7a4b44c..671f5eee 100644
--- a/man/soilColor.wcs.Rd
+++ b/man/soilColor.wcs.Rd
@@ -16,7 +16,7 @@ soilColor.wcs(aoi, var, res = 270, quiet = FALSE)
 \item{quiet}{logical, passed to \code{curl::curl_download} to enable / suppress URL and progress bar for download.}
 }
 \value{
-A SpatRaster (or RasterLayer) object containing indexed map unit keys and associated raster attribute table or a try-error if request fails. By default, spatial classes from the \code{terra} package are returned. If the input object class is from the \code{raster} or \code{sp} packages a RasterLayer is returned.
+A \code{SpatRaster} (or \code{RasterLayer}) object containing indexed map unit keys and associated raster attribute table or a try-error if request fails. By default, spatial classes from the \code{terra} package are returned. If the input object class is from the \code{raster} or \code{sp} packages a \code{RasterLayer} is returned.
 }
 \description{
 Moist soil colors, 2022.