Added checks on returned output for non-matches and will not throw er…

…ror, updated tests accordingly #139
traitecoevo · Jan 6, 2025 · 0dd7e4a · 0dd7e4a
1 parent b3d5d7d
commit 0dd7e4a
Show file tree

Hide file tree

Showing 3 changed files with 37 additions and 11 deletions.
diff --git a/R/checks.R b/R/checks.R
@@ -47,8 +47,28 @@ check_col_exists_in_table <- function(database, table, col){
   )
 }
 
-# # Check if col_value exists in the col
-# # Accommodating for multiple values supplied AND partial matching
+# Check if col_value exists in the col after attempted extraction
+# Accommodating for multiple values supplied AND partial matching
+
+check_col_value_exists <- function(ret, table, col, col_value){
+  if(tibble::is_tibble(ret)){
+    if(nrow(ret) == 0)
+      cli::cli_abort(c(
+        "x" = "`{col_value}` is not a valid value in `{col}` column of the `traits` table",
+        "i" = "Check spelling of `{col_value}` and try again!"
+      )
+      )
+  } else(
+
+  if(nrow(ret$traits) == 0)
+    cli::cli_abort(c(
+      "x" = "`{col_value}` is not a valid value in `{col}` column of the `{table}` table",
+      "i" = "Check spelling of `{col_value}` and try again!"
+    )
+    )
+  )
+}
+
 # 
 # # Get possible col values
 # available_values <- database[[table]][col] |> dplyr::pull() |> unique()

diff --git a/R/extract_data.R b/R/extract_data.R
@@ -50,6 +50,8 @@ extract_data <- function(database, table = NA, col, col_value) {
     # Trim traits, based on the columns identified
     ret <- database %>%
       dplyr::slice(found_indicies)
+
+    check_col_value_exists(ret, table, col, col_value)
 
   # If a full traits.build database is read in
   } else {
@@ -248,11 +250,17 @@ extract_data <- function(database, table = NA, col, col_value) {
   }
 
   # Check full database is provided, assign class
-  if(!tibble::is_tibble(ret))
-  # Assign class
-  attr(ret, "class") <- "traits.build"
-
-  ret
+  if(!tibble::is_tibble(ret)){
+
+    # Check if extraction was successful based on col value
+    check_col_value_exists(ret, table, col, col_value)
+
+    # Assign class
+    attr(ret, "class") <- "traits.build"
+  }
+
+    ret
+
 }
 
 

diff --git a/tests/testthat/test-extract_.R b/tests/testthat/test-extract_.R
@@ -157,12 +157,10 @@ test_that("extracts using generalised extract function behaves as expected - ext
 
 test_that("extracts for which there are no matches work`", {
   context_property_test <- "platypus"
-  expect_message(extract_data(database = austraits_5.0.0_lite,  table = "contexts", col = "context_property", col_value = context_property_test))
-  expect_equal(nrow(extract_data(database = austraits_5.0.0_lite,  table = "contexts", col = "context_property", col_value = context_property_test)$traits), 0)
+  expect_error(extract_data(database = austraits_5.0.0_lite,  table = "contexts", col = "context_property", col_value = context_property_test))
 
   location_property_test <- "green flowers"
-  expect_message(extract_data(database = austraits_5.0.0_lite,  table = "locations", col = "location_property", col_value = location_property_test))
-  expect_equal(nrow(extract_data(database = austraits_5.0.0_lite,  table = "locations", col = "location_property", col_value = location_property_test)$traits), 0)
+  expect_error(extract_data(database = austraits_5.0.0_lite,  table = "locations", col = "location_property", col_value = location_property_test))
 })
 
 test_that("extracts using generalised extract function behaves as expected - extracting by `context_property`", {