test(get.R): add snapshot testing workflow

.Rprofile

@@ -0,0 +1,7 @@
+options(test.run_snapshot = FALSE)
+options(test.run_data_validation = FALSE)
+
+message("ℹ️ test: snapshot and data validation tests are default set to 'RUN = FALSE'")
+message("ℹ️ Run options(test.run_snapshot = TRUE) in the console to activate the snaphot tests.")
+message("ℹ️ Run options(test.run_data_validation = TRUE) in the console to activate the data validation tests.")
+message("ℹ️ See the testing README for more information.")

.gitignore

@@ -39,6 +39,10 @@ rsconnect/
 # pkgdown website is built by travis on gh-pages
 /docs/
 
+# testing snapshots created for local testing
+/tests/testthat/_snaps/*
+
 # Mac OS X
 .DS_Store
 inst/doc
+.positai

DESCRIPTION

@@ -32,17 +32,21 @@ Imports:
 Suggests:
     DBI,
     ggplot2,
+    httr2,
     knitr,
     KSgeneral,
     purrr,
     rmarkdown,
     scales,
     sf,
+    testthat (>= 3.0.0),
     tibble,
-    tidyselect
+    tidyselect,
+    withr
 Remotes:
     inbo/inbodb
 LazyData: true
 Encoding: UTF-8
-RoxygenNote: 7.3.3
 VignetteBuilder: knitr
+Config/testthat/edition: 3
+Config/roxygen2/version: 8.0.0

NAMESPACE

@@ -27,6 +27,7 @@ importFrom(dplyr,"%>%")
 importFrom(dplyr,anti_join)
 importFrom(dplyr,arrange)
 importFrom(dplyr,as_tibble)
+importFrom(dplyr,between)
 importFrom(dplyr,bind_cols)
 importFrom(dplyr,collect)
 importFrom(dplyr,contains)

R/get.R

@@ -1243,6 +1243,7 @@ get_xg3 <- function(locs,
 #' distinct
 #' sql
 #' rename
+#' between
 get_chem <- function(locs,
                      con,
                      startdate,
@@ -1414,14 +1415,6 @@ get_chem <- function(locs,
         )
     )
 
-  sqlstring_en <-
-    paste0(
-      "elneutr BETWEEN ",
-      en_range[1],
-      " AND ",
-      en_range[2]
-    )
-
   # preparing for the application of the en_fecond_threshold:
   if (!is.na(en_fecond_threshold) & !is.null(en_fecond_threshold)) {
     if (any(
@@ -1476,15 +1469,15 @@ get_chem <- function(locs,
         # I.1 applying the en_range condition:
         chem %>%
           filter(
-            (!is.na(.data$elneutr) & sql(sqlstring_en)) |
+            (!is.na(.data$elneutr) & between(.data$elneutr, !!en_range[1], !!en_range[2])) |
               .data$provide_eq_unit == "FALSE"
           )
       } else {
         # I.2 applying the en_fecond_threshold OR the en_range condition:
         chem %>%
           left_join(samples_fecond, by = "lab_sample_id") %>%
           filter(
-            (!is.na(.data$elneutr) & sql(sqlstring_en)) |
+            (!is.na(.data$elneutr) & between(.data$elneutr, !!en_range[1], !!en_range[2])) |
               .data$fecond >= en_fecond_threshold |
               .data$provide_eq_unit == "FALSE"
           ) %>%
@@ -1497,7 +1490,7 @@ get_chem <- function(locs,
         chem %>%
           filter(
             is.na(.data$elneutr) |
-              sql(sqlstring_en) |
+              between(.data$elneutr, !!en_range[1], !!en_range[2]) |
               .data$provide_eq_unit == "FALSE"
           )
       } else {
@@ -1506,7 +1499,7 @@ get_chem <- function(locs,
           left_join(samples_fecond, by = "lab_sample_id") %>%
           filter(
             is.na(.data$elneutr) |
-              sql(sqlstring_en) |
+              between(.data$elneutr, !!en_range[1], !!en_range[2]) |
               .data$fecond >= en_fecond_threshold |
               .data$provide_eq_unit == "FALSE"
           ) %>%

tests/testthat.R

@@ -0,0 +1,12 @@
+# This file is part of the standard setup for testthat.
+# It is recommended that you do not modify it.
+#
+# Where should you do additional test configuration?
+# Learn more about the roles of various files in:
+# * https://r-pkgs.org/testing-design.html#sec-tests-files-overview
+# * https://testthat.r-lib.org/articles/special-files.html
+
+library(testthat)
+library(watina)
+
+test_check("watina")

tests/testthat/README.md

@@ -0,0 +1,74 @@
+## Welcome
+
+First of all, thank you for writing or reviewing tests for `watina`! 👍 Having a strong, automated fallback safety net makes it much more secure for us to perform codebase changes. 😊
+
+## Why these snapshots are not in Git 🔒
+
+The `watina` package interacts heavily with the internal *Watina data warehouse* at INBO. Because the data retrieved via these queries can be confidential, **all generated test snapshot files (`_snaps/`) must never be committed to GitHub**.
+
+Our `.gitignore` is configured to keep all generated snapshot data files completely local to your machine. This prevents accidental data leaks in this public repository.
+
+## Snapshot Testing Workflow 🔄
+
+Whether you are reviewing someone else's pull request or developing a feature yourself, the strategy is identical: you generate a local baseline from a stable state of the code and compare it against your changes.
+
+Since untracked local snapshot files persist across git branch switches, you can leverage testthat to automatically validate different versions of your code.
+
+### 1. Set up a database connection
+
+Create a database connection with the variable name 'test_con'. If this variable is not found, the snapshot tests will be skipped.
+
+``` r
+test_con <- connect_watina()
+```
+
+### 2. Set up your ground truth baseline
+
+*When reviewing a PR, switch to the stable main branch (`git switch main`).*
+
+Run the snapshot tests:
+
+``` r
+devtools::test(filter = "get")
+```
+
+This will create local snapshot files that are stored in tests/testthat/\_snaps.
+
+### 3. Modify your code
+
+Switch to your feature branch if you're reviewing a PR or apply your changes when developing a feature.
+
+### 4. Compare to the baseline
+
+Execute the test code with the applied changes:
+
+``` r
+devtools::test(filter = "get")
+```
+
+**If the tests pass**: The data generated by the modified code is a perfect structural match with your baseline.
+
+**If the tests fail**: testthat will automatically open a Shiny app displaying a row-by-row visual diff highlighting any changes. You can decide to **accept** (if it were expected changes) or **decline** (if it were unintended changes). If you decline, alter your code to assure the output remains unchanged.
+
+## Testing Configuration ⚙️
+
+Testing behavior is managed dynamically through R session `options()`. When you open the project, your `.Rprofile` automatically initializes them.
+
+- **test.run_snapshot** (*default is FALSE*): Toggle to test database query changes. When FALSE, database snapshot tests are skipped.
+- **test.run_data_validation** (*default is FALSE*): Toggle to execute extensive end-to-end table checks (e.g., retrieving all historical rows). Keep FALSE unless verifying a major data warehouse migration.
+
+You can flip these switches directly in your RStudio console at any time. Never modify the default settings in the `.Rprofile`!
+
+``` r
+# Activate snapshot tests
+options(test.run_snapshot = TRUE)
+
+# Activate extensive data validation tests
+options(test.run_data_validation = TRUE)
+
+# Return to default mode
+options(test.run_snapshot = FALSE)
+options(test.run_data_validation = FALSE)
+```
+
+💡 Under the hood: When you run `devtools::test()`, `setup.R` automatically reads these console options. If no active database connection (`test_con`) is found in your Global Environment, database tests will always automatically skip for safety (e.g., on GitHub Actions).

tests/testthat/helper-get.R

@@ -0,0 +1,92 @@
+fetch_watina_connection <- function() {
+  skip_if_not(
+    exists("test_con", envir = .GlobalEnv),
+    message = paste0(
+      "No active database connection found. ",
+      "Create connection by executing 'test_con <- connect_watina()'."
+    )
+  )
+
+  return(get("test_con", envir = .GlobalEnv))
+}
+
+create_file_name <- function(function_name, test_name) {
+  file_end <- "data.csv"
+
+  paste0(function_name, "_", test_name, "_", file_end)
+}
+
+announce_files <- function(file_names, function_name) {
+  for (f in file_names) {
+    announce_snapshot_file(name = create_file_name(function_name, f))
+  }
+}
+
+announce_files_locs <- function(file_names) {
+  announce_files(file_names, "locs")
+}
+
+announce_files_xg3 <- function(file_names) {
+  announce_files(file_names, "xg3")
+}
+
+announce_files_chem <- function(file_names) {
+  announce_files(file_names, "chem")
+}
+
+clean_up_table <- function(table) {
+  floor_0 <- c(
+    "x",
+    "y"
+  )
+  round_2 <- c(
+    "soilsurf_ost",
+    "measuringref_ost",
+    "tubelength",
+    "filterlength",
+    "filterdepth"
+  )
+
+  table <- table %>%
+    # Primary keys can change in DWH (exclude from comparison)
+    select(-ends_with("_wid")) %>%
+    mutate(
+      # Round to only view big numerical changes in comparison view
+      across(any_of(floor_0), floor),
+      across(any_of(round_2), \(x) round(x, digits = 2))
+    ) %>%
+    # Order to ease comparison view
+    arrange(
+      pick(
+        ends_with("_code"),
+        ends_with("year"),
+        ends_with("_ost"),
+        ends_with("_lcl"),
+        ends_with("_variable")
+      )
+    )
+
+  return(table)
+}
+
+write_file <- function(path, table) {
+  write.csv(clean_up_table(table), path, row.names = FALSE)
+}
+
+expect_data <- function(data, function_name, test_name) {
+  path <- tempfile(fileext = ".csv")
+  write_file(path, data)
+  expect_snapshot_file(path, create_file_name(function_name, test_name))
+}
+
+expect_locs <- function(locs, test_name) {
+  expect_data(locs, "locs", test_name)
+}
+
+expect_xg3 <- function(xg3, test_name) {
+  expect_data(xg3, "xg3", test_name)
+}
+
+expect_chem <- function(chem, test_name) {
+  expect_data(chem, "chem", test_name)
+}

tests/testthat/setup.R

@@ -0,0 +1,10 @@
+withr::local_options(
+  list(
+    test.skip_snapshot = !(getOption("test.run_snapshot", default = FALSE)),
+    test.skip_data_validation = !(getOption(
+      "test.run_data_validation",
+      default = FALSE
+    ))
+  ),
+  .local_envir = testthat::teardown_env()
+)