28 add testthat tests

.github/workflows/R-CMD-check.yaml

@@ -27,6 +27,7 @@ jobs:
 
     env:
       GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+      EQ_API_KEY: ${{ secrets.EQ_API_KEY }}
       R_KEEP_PKG_SOURCE: yes
 
     steps:

.github/workflows/test-coverage.yaml

@@ -6,7 +6,8 @@ on:
   pull_request:
     branches: [develop]
     types: [opened, reopened, synchronize, ready_for_review]
-  workflow_dispatch: 
+
+  workflow_dispatch:
 
 concurrency:
   group: ${{ github.workflow }}-${{ github.event.pull_request.number || github.ref }}

DESCRIPTION

@@ -15,7 +15,7 @@ Copyright: This software is in the public domain because it contains materials
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.3.3
-Imports:
+Imports: 
   data.table,
   dplyr,
   httr2,
@@ -27,25 +27,26 @@ Imports:
   tibble,
   tidyr,
   utils
-Suggests:
+Suggests: 
     datasets,
     devtools,
     DT,
     ggplot2,
+    httptest2,
     httr,
     knitr,
     leaflet,
     maps,
     pkgdown,
     plotly,
-    rmarkdown,
     remotes,
+    rmarkdown,
     roxygen2,
     sf,
     spelling,
     stringi,
-    testthis,
     testthat (>= 3.0.0),
+    testthis,
     usdata,
     usethis,
     usmap,

R/EQ_DomainValues.R

@@ -75,15 +75,15 @@ EQ_DomainValues <- function(domain = NULL) {
         # remote path (as you requested)
         eq.params <- raw.data |>
           dplyr::select(domain) |>
-          dplyr::rename(attains_ws_name = .data$domain) |>
+          dplyr::rename(attains_ws_name = domain) |>
           dplyr::left_join(param.cw, by = dplyr::join_by(attains_ws_name)) |>
-          dplyr::filter(!is.na(.data$eq_name)) |>
+          dplyr::filter(!is.na(eq_name)) |>
           dplyr::transmute(
-            eq_param = .data$param,
-            attains_ws_name = .data$attains_ws_name,
-            attains_ws_field = .data$attains_ws_field
-          ) %>%
-          dplyr::arrange(.data$eq_param)
+            eq_param = param,
+            attains_ws_name = attains_ws_name,
+            attains_ws_field = attains_ws_field
+          ) |>
+          dplyr::arrange(eq_param)
 
         message("EQ_DomainValues: domain list retrieved from ATTAINS web services.")
         return(eq.params)
@@ -115,8 +115,8 @@ EQ_DomainValues <- function(domain = NULL) {
 
       # get param name for web services
       param.ws <- param.cw |>
-        dplyr::filter(.data$param == .env$domain) |>
-        dplyr::pull(.data$attains_ws_name)
+        dplyr::filter(param == .env$domain) |>
+        dplyr::pull(attains_ws_name)
 
       # cols to retain
       retain.cols <- c(
@@ -140,13 +140,13 @@ EQ_DomainValues <- function(domain = NULL) {
 
         # remote path
         eq.params <- raw.data |>
-          dplyr::rename(attains_ws_name = .data$domain) |>
+          dplyr::rename(attains_ws_name = domain) |>
           dplyr::left_join(param.cw, by = "attains_ws_name",
                            relationship = "many-to-many") |>
-          dplyr::filter(.data$param == .env$domain) |>
-          dplyr::rename(eq_param = .data$param) |>
+          dplyr::filter(param == .env$domain) |>
+          dplyr::rename(eq_param = param) |>
           dplyr::select(dplyr::all_of(retain.cols)) |>
-          dplyr::arrange(.data$eq_param) |>
+          dplyr::arrange(eq_param) |>
           dplyr::distinct()
 
         print(paste0(
@@ -174,10 +174,10 @@ EQ_DomainValues <- function(domain = NULL) {
                   dplyr::left_join(param.cw, by = c("attains_ws_name",
                                                     "attains_ws_field"),
                            relationship = "many-to-many") |>
-        dplyr::filter(.data$param == .env$domain) |>
-        dplyr::rename(eq_param = .data$param) |>
+        dplyr::filter(param == .env$domain) |>
+        dplyr::rename(eq_param = param) |>
         dplyr::select(dplyr::all_of(retain.cols)) |>
-        dplyr::arrange(.data$eq_param) |>
+        dplyr::arrange(eq_param) |>
         dplyr::distinct()
 
       print(paste0(
@@ -219,15 +219,15 @@ param.cw <- utils::read.csv(system.file("extdata", "EQParamsCrosswalk.csv",
 
     eq.params <- raw.data |>
       dplyr::select(domain) |>
-      dplyr::rename(attains_ws_name = .data$domain) |>
+      dplyr::rename(attains_ws_name = domain) |>
       dplyr::left_join(param.cw, by = "attains_ws_name") |>
-      dplyr::filter(!is.na(.data$eq_name)) |>
+      dplyr::filter(!is.na(eq_name)) |>
       dplyr::transmute(
-        eq_param = .data$param,
-        attains_ws_name = .data$attains_ws_name,
-        attains_ws_field = .data$attains_ws_field
-      ) %>%
-      dplyr::arrange(.data$eq_param)
+        eq_param = param,
+        attains_ws_name = attains_ws_name,
+        attains_ws_field = attains_ws_field
+      ) |>
+      dplyr::arrange(eq_param)
 
     save(eq.params, file = file.path("inst", "extdata", "DomainValuesNull.rda"), compress = "xz")
 }
@@ -252,9 +252,9 @@ EQ_UpdateInternalDomainValues<- function() {
     dplyr::distinct()
 
   attains_ws_name <- param.cw |>
-    dplyr::select(.data$attains_ws_name) |>
-    dplyr::filter(.data$attains_ws_name != "" &
-                    !is.na(.data$attains_ws_name)) |>
+    dplyr::select(attains_ws_name) |>
+    dplyr::filter(attains_ws_name != "" &
+                    !is.na(attains_ws_name)) |>
     dplyr::distinct() |>
     dplyr::pull()
 

R/EQ_HelperFunctions.R

@@ -81,7 +81,7 @@ EQ_FormatParams <- function(.data) {
   })
 
   params.df <- params.df |>
-    dplyr::mutate(value = as.character(.data$value))
+    dplyr::mutate(value = as.character(value))
 
   return(params.df)
 }
@@ -104,7 +104,7 @@ EQ_FormatParams <- function(.data) {
 EQ_CompareParams <- function(default, user) {
   # filter out any default params that user entered a value for
   default.params <- default |>
-    dplyr::filter(!.data$param %in% user$param)
+    dplyr::filter(!param %in% user$param)
 
   # combine user supplied and default params
   all.params <- user |>
@@ -161,42 +161,42 @@ EQ_CreateBody <- function(comp.params, crosswalk, extract) {
   # Prepare filter rows with eq_name mapping
   filt <- comp.params |>
     dplyr::filter(
-      !is.na(.data$value),
-      !(.data$value %in% c("NULL", "latest")),
-      .data$param != "api_key"
+      !is.na(value),
+      !(value %in% c("NULL", "latest")),
+      param != "api_key"
     ) |>
     dplyr::mutate(
       value = dplyr::case_when(
-        .data$param == "report_cycle" & .data$value == "any" ~ "-1",
-        .data$param == "region" & !is.null(.data$value) & .data$value != "10" ~ paste0("0", .data$value),
-        .data$param %in% c("au_status", "delisted", "pollutant_ind", "vis", "in_meas", "indian_country") &
-          !is.null(.data$value) ~ substr(.data$value, 1, 1),
-        .data$param == "use_support" & .data$value == "Fully Supporting" ~ "F",
-        .data$param == "use_support" & .data$value == "Not Supporting" ~ "N",
-        .data$param == "use_support" & .data$value == "Insufficient Information" ~ "I",
-        .data$param == "use_support" & .data$value == "Not Assessed" ~ "X",
-        TRUE ~ as.character(.data$value)
+        param == "report_cycle" & value == "any" ~ "-1",
+        param == "region" & !is.null(value) & value != "10" ~ paste0("0", value),
+        param %in% c("au_status", "delisted", "pollutant_ind", "vis", "in_meas", "indian_country") &
+          !is.null(value) ~ substr(value, 1, 1),
+        param == "use_support" & value == "Fully Supporting" ~ "F",
+        param == "use_support" & value == "Not Supporting" ~ "N",
+        param == "use_support" & value == "Insufficient Information" ~ "I",
+        param == "use_support" & value == "Not Assessed" ~ "X",
+        TRUE ~ as.character(value)
       )
     ) |>
     dplyr::left_join(crosswalk, by = dplyr::join_by("param")) |>
     # Clean deparsed vectors like c("a","b")
-    dplyr::mutate(value = gsub('c\\(|\\)|"', "", .data$value)) |>
+    dplyr::mutate(value = gsub('c\\(|\\)|"', "", value)) |>
     # Split multi-value params into atomic tokens
-    tidyr::separate_rows(.data$value, sep = ",\\s*") |>
-    dplyr::mutate(value = trimws(.data$value)) |>
+    tidyr::separate_rows(value, sep = ",\\s*") |>
+    dplyr::mutate(value = trimws(value)) |>
     # Convert only ISO YYYY-MM-DD strings for date params
     dplyr::mutate(
       value = dplyr::if_else(
-        .data$param %in% date.params & grepl("^\\d{4}-\\d{2}-\\d{2}$", .data$value),
-        format(as.Date(.data$value, format = "%Y-%m-%d"), "%m-%d-%Y"),
-        .data$value
+        param %in% date.params & grepl("^\\d{4}-\\d{2}-\\d{2}$", value),
+        format(as.Date(value, format = "%Y-%m-%d"), "%m-%d-%Y"),
+        value
       )
     )
 
   # Build filters as a named list: non-date fields become vectors; date/query stay scalar
   filt_list <- filt |>
-    dplyr::group_by(.data$eq_name) |>
-    dplyr::summarise(values = list(unique(.data$value)), .groups = "drop")
+    dplyr::group_by(eq_name) |>
+    dplyr::summarise(values = list(unique(value)), .groups = "drop")
 
   # Named list for JSON
   filters_obj <- rlang::set_names(filt_list$values, filt_list$eq_name)
@@ -220,7 +220,7 @@ EQ_CreateBody <- function(comp.params, crosswalk, extract) {
     dplyr::select("col.name", dplyr::all_of(extract.filter)) |>
     dplyr::filter(!is.na(.data[[extract.filter]])) |>
     dplyr::arrange(.data[[extract.filter]]) |>
-    dplyr::pull(.data$col.name) |>
+    dplyr::pull(col.name) |>
     unique()
 
   # JSON bodies using jsonlite (no manual paste)
@@ -386,3 +386,34 @@ EQ_FormatPlanLinks <- function(.data, url.col = "planSummaryLink") {
     ))
   return(.data)
 }
+
+#' Set EQ_API_KEY for local and automated testing
+#'
+#' @param .data Data frame to convert planSummaryLink to functional URL links for use in data tables.
+#' @param url.col Column name containing string for formatting. Default is "planSummaryLink".
+#'
+#' @return The .data data frame with planSummaryLink entries formatted as URL links.
+#'
+# check to see if key is stored in R session
+# this allows developers to easily use their own key during local dev and testing
+# per session: Sys.setenv(EQ_API_KEY = "your-api-key")
+
+
+.setEQKey <- function() {
+opt <- getOption("EQ_API_KEY", "")
+if (nzchar(opt)) {
+  return(opt)
+}
+
+# check to see if key is stored in system environment (primarily for use in checks)
+env <- Sys.getenv("EQ_API_KEY", unset = "")
+if (nzchar(env)) {
+  return(env)
+}
+
+# if neither exist
+def <- NULL
+if (!nzchar(opt) & !nzchar(env)) {
+  return(def)
+}
+}