Merge pull request #10 from AAGI-AUS/feature/add-tests

.Rbuildignore

@@ -8,3 +8,4 @@
 ^docs$
 ^pkgdown$
 ^codemeta\.json$
+^.devcontainer*

.devcontainer/devcontainer.json

@@ -0,0 +1,15 @@
+{
+  "name": "nert-container",
+  "image": "ghcr.io/rocker-org/devcontainer/r-ver:4",
+  "features": {
+    "ghcr.io/rocker-org/devcontainer-features/r-packages:1": {
+      "packages": [
+        "roxyglobals",
+        "terra",
+        "data.table",
+        "lubridate"
+      ]
+    }
+  },
+  "postCreateCommand": "./.devcontainer/postCreateCommand.sh"
+}

.devcontainer/postCreateCommand.sh

@@ -0,0 +1,2 @@
+sudo apt-get -y update
+sudo apt-get install -y libudunits2-dev libgdal-dev libgeos-dev libproj-dev

.gitignore

@@ -5,3 +5,4 @@
 .DS_Store
 .quarto
 docs
+.Renviron

DESCRIPTION

@@ -6,7 +6,9 @@ Authors@R: c(
            comment = c(ORCID = "0000-0002-0061-8359")),
     person("Russell", "Edson", , "[email protected]", role = "aut",
            comment = c(ORCID = "0000-0002-4607-5396")),
-    person("Max", "Moldovan", , "[email protected]", role = "ctb")
+    person("Max", "Moldovan", , "[email protected]", role = "ctb"),
+    person("Wasin", "Pipattungsakul", , "[email protected]", 
+           role = "aut")
   )
 Description: Provides access to Australia's TERN (Terrestrial Ecosystem
     Research Network) data through the API, <https://tern.org.au>.

R/read_smips.R

@@ -64,6 +64,7 @@ read_smips <- function(collection = "totalbucket",
 
   while (attempt <= max_tries && !success)
     tryCatch({
+      # TODO: move the url concatenation out
       r <- (terra::rast(
         paste0(
           "/vsicurl/https://",
@@ -136,7 +137,6 @@ read_smips <- function(collection = "totalbucket",
 #' @keywords Internal
 #' @autoglobal
 #' @noRd
-
 .check_not_example_api_key <- function(.api_key) {
   if (!is.null(.api_key) && .api_key == "your_api_key") {
     stop(
@@ -162,7 +162,6 @@ read_smips <- function(collection = "totalbucket",
 #'
 #' @noRd
 #' @keywords Internal
-
 .check_collection_agreement <- function(.collection, .day) {
   .this_year <- lubridate::year(lubridate::today())
   .last_week <- lubridate::today() - 7
@@ -186,7 +185,6 @@ read_smips <- function(collection = "totalbucket",
 #' @autoglobal
 #' @noRd
 #' @keywords Internal
-
 .make_smips_url <- function(.collection, .day) {
   url_date <- gsub("-", "", .day)
 
@@ -195,7 +193,7 @@ read_smips <- function(collection = "totalbucket",
                             "bucket1",
                             "bucket2",
                             "deepD",
-                            "runnoff")
+                            "runoff")
   collection <- rlang::arg_match(.collection, approved_collections)
 
   .check_collection_agreement(.collection = .collection, .day = .day)
@@ -214,4 +212,6 @@ read_smips <- function(collection = "totalbucket",
     collection == "runoff",
     paste0("smips_runoff_mm_", url_date, ".tif")
   )
+
+  return(collection_url)
 }

tests/testthat/test-.check_collection_agreement.R

@@ -0,0 +1,19 @@
+test_that("A valid collection combination passes", {
+  expect_null(.check_collection_agreement("totalbucket", as.Date("2007-01-01")))
+  expect_null(.check_collection_agreement("some_collection", as.Date("2007-01-01")))
+  expect_null(.check_collection_agreement("some_collection", lubridate::today() - 7))
+})
+
+test_that("An invalid collection combination throws an error", {
+  last_week <- lubridate::today() - 7
+
+  error_msg <- paste0("The data are not available before 2005 and roughly much past ", last_week)
+  expect_error(
+    .check_collection_agreement("some_collection", lubridate::today()),
+    error_msg
+  )
+  expect_error(
+    .check_collection_agreement("totalbucket", as.Date("2004-01-01")),
+    error_msg
+  )
+})

tests/testthat/test-.check_date.R

@@ -0,0 +1,82 @@
+test_that("Date validation works with valid dates", {
+  reference_date <- "2020-01-01"
+
+  # posix object
+  date_ <- lubridate::as_datetime(reference_date)
+  date_checked <- .check_date(date_)
+
+  expect_true(lubridate::is.POSIXct(date_checked))
+  expect_equal(date_checked, date_)
+
+  # date object
+  date_ <- as.Date(reference_date)
+  date_checked <- .check_date(date_)
+
+  expect_true(lubridate::is.POSIXct(date_checked))
+  expect_equal(toString(date_checked), toString(date_))
+
+  # different timezone
+  date_ <- lubridate::as_datetime(reference_date, tz = "Australia/Adelaide")
+  date_checked <- .check_date(date_)
+
+  expect_true(lubridate::is.POSIXct(date_checked))
+  expect_equal(date_checked, date_)
+
+  # various string formats
+  # Ymd
+  date_checked <- .check_date("2020-01-01")
+
+  expect_true(lubridate::is.POSIXct(date_checked))
+  expect_equal(toString(date_checked), reference_date)
+
+  # dmY
+  date_checked <- .check_date("01-01-2020")
+
+  expect_true(lubridate::is.POSIXct(date_checked))
+  expect_equal(toString(date_checked), reference_date)
+
+  # BdY, bdY
+  date_checked <- .check_date("january-01-2020")
+
+  expect_true(lubridate::is.POSIXct(date_checked))
+  expect_equal(toString(date_checked), reference_date)
+
+  date_checked <- .check_date("Jan-01-2020")
+
+  expect_true(lubridate::is.POSIXct(date_checked))
+  expect_equal(toString(date_checked), reference_date)
+
+  # Bdy, bdy
+  date_checked <- .check_date("January-01-20")
+
+  expect_true(lubridate::is.POSIXct(date_checked))
+  expect_equal(toString(date_checked), reference_date)
+
+  date_checked <- .check_date("jan-01-20")
+
+  expect_true(lubridate::is.POSIXct(date_checked))
+  expect_equal(toString(date_checked), reference_date)
+})
+
+test_that("Date validation throws error with invalid dates", {
+  # multiple dates
+  expect_error(.check_date(c("2020-01-01", "2020-01-02")), "Only one day is allowed per request.")
+
+  # invalid formats
+  expect_error(
+    .check_date("2020-31-12"),
+    "2020-31-12 is not in a valid date format. Please enter a valid date format."
+  )
+  expect_error(
+    .check_date("2020-12-33"),
+    "2020-12-33 is not in a valid date format. Please enter a valid date format."
+  )
+  expect_error(
+    .check_date("jane-01-20"),
+    "jane-01-20 is not in a valid date format. Please enter a valid date format."
+  )
+  expect_error(
+    .check_date("today"),
+    "today is not in a valid date format. Please enter a valid date format."
+  )
+})

tests/testthat/test-.check_not_example_api_key.R

@@ -0,0 +1,4 @@
+test_that("An error is raised when the API key is the example string", {
+  # multiple dates
+  expect_error(.check_not_example_api_key("your_api_key"))
+})

tests/testthat/test-.make_smips_url.R

@@ -0,0 +1,30 @@
+test_that("A valid url part is created", {
+  date_ <- as.Date("2020-01-01")
+
+  # different collections
+  expect_equal(.make_smips_url("totalbucket", date_), "smips_totalbucket_mm_20200101.tif")
+  expect_equal(.make_smips_url("SMindex", date_), "smips_smi_perc_20200101.tif")
+  expect_equal(.make_smips_url("bucket1", date_), "smips_bucket1_mm_20200101.tif")
+  expect_equal(.make_smips_url("bucket2", date_), "smips_bucket2_mm_20200101.tif")
+  expect_equal(.make_smips_url("deepD", date_), "smips_deepD_mm_20200101.tif")
+
+  # different date
+  expect_equal(.make_smips_url("runoff", as.Date("2020-01-02")), "smips_runoff_mm_20200102.tif")
+})
+
+test_that("An invalid collection throws an error", {
+  valid_collections <- c(
+    "totalbucket",
+    "SMindex",
+    "bucket1",
+    "bucket2",
+    "deepD",
+    "runoff"
+  )
+  valid_collections_str <- paste(valid_collections[seq_along(valid_collections) - 1], collapse = '", "')
+  valid_collections_str <- paste0('"', valid_collections_str, '", "', tail(valid_collections, 1), '"')
+
+  # TODO: check error message
+  error_msg <- paste0("`.collection` must be one of ", valid_collections_str, ', not "asdf".')
+  expect_error(.make_smips_url("asdf", as.Date("2020-01-01")))
+})