Merge pull request #2 from AAGI-AUS/devel

DESCRIPTION

@@ -10,10 +10,12 @@ Description: Provides access to Australia's TERN (Terrestrial Ecosystem
     Research Network) data through the API, <https://tern.org.au>.
 License: MIT + file LICENSE
 Suggests: 
+    roxyglobals,
     testthat (>= 3.0.0)
 Config/testthat/edition: 3
 Encoding: UTF-8
-Roxygen: list(markdown = TRUE)
+Roxygen: list(markdown = TRUE, roclets = c("collate", "namespace", "rd",
+    "roxyglobals::global_roclet"))
 RoxygenNote: 7.3.2
 Imports: 
     cli,
@@ -22,3 +24,5 @@ Imports:
     rlang,
     terra,
     utils
+Config/roxyglobals/filename: globals.R
+Config/roxyglobals/unique: FALSE

NAMESPACE

@@ -1,7 +1,6 @@
 # Generated by roxygen2: do not edit by hand
 
 export(get_key)
-export(get_smips)
 export(plot)
 export(read_cog)
 export(read_cog_dt)

R/get_key.R

@@ -5,6 +5,16 @@
 #'   that your key that \R is using is the key that you wish to be using or for
 #'   guidance in setting up the keys.
 #'
+#' # Requesting an API Key
+#'
+#' To request an \acronym{API} key, go to
+#'   <https://account.tern.org.au/authenticated_user/apikeys> and click on
+#'   "Sign In" in the upper right corner. Sign in with your proper credentials.
+#'   Then, from the left-hand menu, click on "Create API Key".  Once this is
+#'   done, copy the key and put it in your .Renviron using
+#'   [usethis::edit_r_environ] as `TERN_API_KEY="your_api_key"`. Restart your
+#'   \R session and the query should work.
+#'
 #' @note
 #' \acronym{TERN} creates \acronym{API} keys that have special characters that
 #'   include \dQuote{/}, which causes the query to fail. Currently, `get_key()`

R/globals.R

@@ -0,0 +1,5 @@
+# Generated by roxyglobals: do not edit by hand
+
+utils::globalVariables(c(
+  NULL
+))

R/read_cog.R

@@ -17,8 +17,10 @@
 #'  * deepD
 #'  * runoff
 #'  * totalbucket
-#'  Defaults to \dQuote{totalbucket}.
-#' @param day A single day's date to query, _e.g._, `day = "2017-12-31"`, both
+#'  Defaults to \dQuote{totalbucket}. Multiple `collections` are supported,
+#'  _e.g._, `collection = c("SMindex", "totalbucket")`.
+#' @param day A vector of date(s) to query, _e.g._, `day = "2017-12-31"` or
+#'  `day = seq.Date(as.Date("2017-12-01"), as.Date("2017-12-31"), "days")`, both
 #'  `Character` and `Date` classes are accepted.
 #' @param api_key A `character` string containing your \acronym{API} key,
 #'   a random string provided to you by \acronym{TERN}, for the request.
@@ -39,19 +41,22 @@
 #' plot(r)
 #'
 #' @return A [terra::rast] object
+#'
+#' @autoglobal
 #' @references <https://portal.tern.org.au/metadata/TERN/d1995ee8-53f0-4a7d-91c2-ad5e4a23e5e0https://geonetwork.tern.org.au/geonetwork/srv/eng/catalog.search#/metadata/d1995ee8-53f0-4a7d-91c2-ad5e4a23e5e0>
 #' @export
 
 read_cog <- function(data = "smips",
                      collection = "totalbucket",
                      day,
                      api_key = get_key()) {
-  day <- lubridate::ymd(day)
+
+  day <- .check_date(day)
   url_year <- lubridate::year(day)
 
   if (data == "smips") {
     collection_url <- .make_smips_url(.collection = collection, .day = day)
-    return(terra::rast(
+    r <- (terra::rast(
       paste0(
         "/vsicurl/https://",
         paste0("apikey:", api_key),
@@ -64,5 +69,90 @@ read_cog <- function(data = "smips",
       )
     )
     )
+
+    return(r)
+  }
+}
+
+#' Check that the user hasn't blindly copied the "your_api_key" string from the
+#' examples
+#'
+#' @keywords Internal
+#' @autoglobal
+#' @noRd
+
+.check_not_example_api_key <- function(.api_key) {
+  if (!is.null(.api_key) && .api_key == "your_api_key") {
+    stop("You have copied the example code and not provided a proper API key.
+         An API key may be requested from TERN to access this resource. Please
+         see the help file for {.fn get_key} for more information.",
+         call. = FALSE)
+  }
+  return(invisible(NULL))
+}
+
+#' Validate Days Requested Align With Collection
+#'
+#' Not all dates are offered by all collections. This checks the user inputs to
+#' be sure that unavailable dates are not requested from collections that do not
+#' provide them.
+#'
+#' @param .collection The user-supplied SMIPS collection being asked for.
+#' @param .day The user-supplied date being asked for.
+#'
+#' @autoglobal
+#'
+#' @noRd
+#' @keywords Internal
+
+.check_collection_agreement <- function(.collection, .day) {
+  .this_year <- lubridate::year(lubridate::today())
+  .last_week <- lubridate::today() - 7
+  .url_year <- lubridate::year(.day)
+
+  if (.collection == "totalbucket" &&
+      .url_year < 2005 ||
+      .day > .last_week) {
+    cli::cli_abort("The data are not available before 2005 and past {.last_week}")
   }
 }
+
+#' Create an SMIPS URL
+#'
+#' Creates the SMIPS specific portion of a URL to read or fetch a COG.
+#'
+#' @param .collection The user-supplied SMIPS collection being asked for.
+#' @param .day The user-supplied date being asked for.
+#'
+#' @autoglobal
+#' @noRd
+#' @keywords Internal
+
+.make_smips_url <- function(.collection, .day) {
+  url_date <- gsub("-", "", .day)
+
+  approved_collections <- c("totalbucket",
+                            "SMindex",
+                            "bucket1",
+                            "bucket2",
+                            "deepD",
+                            "runnoff")
+  collection <- rlang::arg_match(.collection, approved_collections)
+
+  .check_collection_agreement(.collection = .collection, .day = .day)
+
+  collection_url <- data.table::fcase(
+    collection == "totalbucket",
+    paste0("smips_totalbucket_mm_", url_date, ".tif"),
+    collection == "SMindex",
+    paste0("smips_smi_perc_", url_date, ".tif"),
+    collection == "bucket1",
+    paste0("smips_bucket1_mm_", url_date, ".tif"),
+    collection == "bucket2",
+    paste0("smips_bucket2_mm_", url_date, ".tif"),
+    collection == "deepD",
+    paste0("smips_deepD_mm_", url_date, ".tif"),
+    collection == "runoff",
+    paste0("smips_runoff_mm_", url_date, ".tif")
+  )
+}

R/read_cog_dt.R

@@ -10,28 +10,65 @@
 #' @inherit read_cog
 #'
 #' @family COGs
-#'
+#' @author Adam H. Sparks \email{adamhsparks@@curtin.edu.au}
 #' @examplesIf interactive()
 #'
-#' r <- read_cog_dt(day = "2024-01-01")
+#' r <- read_cog_dt(day = "2024-01-01", api_key = "your_api_key")
 #'
 #' r
 #'
 #' @return A [data.table::data.table] object
+#' @autoglobal
 #' @references <https://portal.tern.org.au/metadata/TERN/d1995ee8-53f0-4a7d-91c2-ad5e4a23e5e0https://geonetwork.tern.org.au/geonetwork/srv/eng/catalog.search#/metadata/d1995ee8-53f0-4a7d-91c2-ad5e4a23e5e0>
 #' @export
 
 read_cog_dt <- function(data = "smips",
                         collection = "totalbucket",
                         day,
                         api_key = get_key()) {
-  r <- read_cog(
-    data = data,
-    collection = collection,
-    day = day,
-    api_key = api_key
-  )
-  r <- data.table::setDT(terra::as.data.frame(r, xy = TRUE))
+  r <- data.table::setDT(terra::as.data.frame(
+    read_cog(
+      data = data,
+      collection = collection,
+      day = day,
+      api_key = api_key
+    ), xy = TRUE
+  ))
+
   data.table::setnames(r, old = c("x", "y"), new = c("lon", "lat"))
   return(r)
 }
+
+#' Check User Input Dates for Validity
+#'
+#' @param x User entered date value
+#' @return Validated date string as a `POSIXct` object.
+#' @note This was taken from \CRANpkg{nasapower}.
+#' @example .check_date(x)
+#' @author Adam H. Sparks \email{adamhsparks@@curtin.edu.au}
+#' @keywords Internal
+#' @autoglobal
+#' @noRd
+.check_date <- function(x) {
+  tryCatch(
+    x <- lubridate::parse_date_time(x,
+                                    c(
+                                      "Ymd",
+                                      "dmY",
+                                      "mdY",
+                                      "BdY",
+                                      "Bdy",
+                                      "bdY",
+                                      "bdy"
+                                    ),
+                                    tz = Sys.timezone()),
+    warning = function(c) {
+      stop(call. = FALSE,
+           "\n",
+           x,
+           " is not in a valid date format. Please enter a valid date format.",
+           "\n")
+    }
+  )
+  return(x)
+}