remove custom S3 classes from galah_ functions (#133)

Replacement behaviour is to add `attr(x, "call") <- "function_name"` - this has been implemented for all `galah_` functions and for taxonomic search functions (`search_taxa` and `search_identifiers`. However, `galah_call` is not yet updated, meaning that piping currently fails

R/atlas_media.R

@@ -193,15 +193,16 @@ atlas_media_internal <- function(request,
   )
 
   # add galah_ classes to modified filter and select
-  class(occ_filter) <- append(class(occ_filter), "galah_filter")
-  class(occ_columns) <- append(class(occ_columns), "galah_select")
+  attr(occ_filter, "call") <- "galah_filter"
+  attr(occ_columns, "call") <- "galah_media"
   if (verbose) { inform("Downloading records with media...") }
 
-  occ <- atlas_occurrences_internal(identify, 
-    occ_filter, 
-    geolocate, 
-    data_profile, 
-    occ_columns)
+  occ <- atlas_occurrences_internal(
+    identify = identify, 
+    filter = occ_filter, 
+    geolocate = geolocate, 
+    profile = data_profile, 
+    select = occ_columns)
 
   if(nrow(occ) < 1){
     inform("Exiting `atlas_media`")

R/deprecated_functions.R

@@ -14,7 +14,7 @@ select_taxa <- function(query, is_id = FALSE) {
     galah_identify(query, search = FALSE)
   }else{
     result <- galah_identify(query, search = TRUE) |> as.data.frame()
-    class(result) <- append(class(result), "galah_identify")
+    attr(result, "call") <- "galah_identify"
     return(result)
   }
 }

R/galah_call.R

@@ -98,7 +98,7 @@ galah_call <- function(identify = NULL,
 
 check_call_args <- function(arg_supplied, arg_name, error_call = caller_env()){
   if(
-    !is.null(arg_supplied) && 
+    !is.null(arg_supplied) &&
     !inherits(arg_supplied, paste0("galah_", arg_name))
   ){
     abort(

R/galah_data_profile.R

@@ -43,7 +43,7 @@ galah_data_profile <- function(...){
   }
 
   # if a data request was supplied, return one
-  class(result) <- append(class(result), "galah_data_profile")
+  attr(result, "call") <- "galah_data_profile"
   if (is_data_request) {
     update_galah_call(data_request, data_profile = result)
   } else {

R/galah_down_to.R

@@ -85,7 +85,7 @@ galah_down_to <- function(...){
   rank <- dequote(unlist(lapply(dots, as_label)))
   if(rank %in% show_all_ranks()$name){
     result <- tibble(rank = rank)
-    class(result) <- append(class(result), "galah_down_to")
+    attr(result, "call") <- "galah_down_to"
   }else{
     bullets <- c(
       "Invalid taxonomic rank.",

R/galah_filter.R

@@ -12,11 +12,11 @@
 #' syntax.
 #'
 #' @param ... filters, in the form `field logical value`
-#' @param profile `string`: (optional) a data quality profile to apply to the
-#' records. See [show_all_profiles()] for valid profiles. By default
+#' @param profile DEPRECATED: use `galah_data_profile` instead. If supplied, 
+#' should be a `string` recording a data quality profile to apply to the
+#' query. See [show_all_profiles()] for valid profiles. By default
 #' no profile is applied.
-#' @return An object of class `data.frame` and `galah_filter`,
-#' containing filter values.
+#' @return A tibble containing filter values.
 #' @seealso [search_taxa()] and [galah_geolocate()] for other ways to restrict 
 #' the information returned by [atlas_occurrences()] and related functions. Use
 #' [search_fields()] to find fields that
@@ -148,7 +148,9 @@ galah_filter <- function(..., profile = NULL){
     named_filters$query <- parse_query(named_filters)
 
     # Validate that variables exist in ALA
-    if (getOption("galah_config")$run_checks) validate_fields(named_filters$variable)
+    if (getOption("galah_config")$run_checks){     
+      validate_fields(named_filters$variable)
+    }
 
   }else{ 
     # If no fields are entered, return an empty data frame of arguments
@@ -158,10 +160,10 @@ galah_filter <- function(..., profile = NULL){
                      query = character())
   }
 
-  # Set class
+  # Set class and 'call' attribute
   named_filters <- as_tibble(named_filters)
-  class(named_filters) <- append(class(named_filters), "galah_filter")
-  
+  attr(named_filters, "call") <- "galah_filter"
+
   # Check and apply profiles to query
   named_filters <- apply_profiles(profile, named_filters)
 

R/galah_geolocate.R

@@ -76,7 +76,7 @@ galah_geolocate <- function(...) {
     }
     out_query <- query
   }
-  class(out_query) <- append(class(out_query), "galah_geolocate")
+  attr(out_query, "call") <- "galah_geolocate"
 
   # if a data request was supplied, return one
   if(is_data_request){

R/galah_group_by.R

@@ -85,17 +85,17 @@ galah_group_by <- function(..., expand = TRUE){
     if(length(available_variables) > 0){
       df <- tibble(name = available_variables)
       df$type <- ifelse(str_detect(df$name, "[[:lower:]]"), "field", "assertions")
-      class(df) <- append(class(df), "galah_group_by")
+      attr(df, "call") <- "galah_group_by"
       attr(df, "expand") <- expand
     }else{
       df <- tibble(name = "name", type = "type", .rows = 0)
-      df <- set_galah_object_class(df, new_class = "galah_group_by")
+      attr(df, "call") <- "galah_group_by"
       attr(df, "expand") <- expand
       df
     }
   }else{
     df <- tibble(name = "name", type = "type", .rows = 0)
-    df <- set_galah_object_class(df, new_class = "galah_group_by")
+    attr(df, "call") <- "galah_group_by"
     attr(df, "expand") <- expand
     df
   }

R/galah_identify.R

@@ -12,7 +12,7 @@
 #' @param search (logical); should the results in question be passed to
 #'   `search_taxa`? Ignored if an object of class `ala_id`, `gbifid`, or `nbnid` 
 #'   is given to `...`.
-#'
+#' @return A tibble containing identified taxa.
 #' @seealso [search_taxa()] to find identifiers from scientific names;
 #' [search_identifiers()] for how to get names if taxonomic identifiers 
 #' are already known.
@@ -133,7 +133,7 @@ galah_identify <- function(..., search = TRUE) {
   }
 
   # if a data request was supplied, return one
-  class(result) <- append(class(result), "galah_identify")
+  attr(result, "call") <- "galah_identify"
   if (is_data_request) {
     update_galah_call(data_request, identify = result)
   } else {

R/galah_select.R

@@ -13,7 +13,7 @@
 #' @param group `string`: (optional) name of one or more column groups to
 #' include. Valid options are `"basic"`, `"event"` and
 #' `"assertions"`
-#' @return An object of class `data.frame` and `galah_select`
+#' @return A tibble
 #' specifying the name and type of each column to include in the 
 #' call to `atlas_counts()` or `atlas_occurrences()`.
 #' @details
@@ -124,7 +124,7 @@ galah_select <- function(...,
 
   # Add S3 class
   all_cols <- as_tibble(all_cols)
-  class(all_cols) <- append(class(all_cols), "galah_select") 
+  attr(all_cols, "call") <- "galah_select" 
 
   # if a data request was supplied, return one
   if(is_data_request){

R/search_identifiers.R

@@ -33,11 +33,13 @@ search_identifiers <- function(identifier) {
       )
       inform(bullets)
     }
-    return(set_galah_object_class(new_class = "ala_id"))
-  }else{ 
-    set_galah_object_class(
-      rbindlist(matches, fill = TRUE), 
-      new_class = "ala_id") 
+    df <- tibble()
+    attr(df, "call") <- "ala_id"
+    return(df)
+  }else{
+    df <- as_tibble(rbindlist(matches, fill = TRUE)) 
+    attr(df, "call") <- "ala_id"
+    return(df) 
   }
 }
 

R/search_taxa.R

@@ -25,7 +25,8 @@ search_taxa <- function(...) {
   } 
 
   matches <- remove_parentheses(query) |> 
-    name_query() 
+    name_query() |>
+    as_tibble()
 
   if(is.null(matches) & galah_config()$verbose){
     bullets <- c(
@@ -34,9 +35,12 @@ search_taxa <- function(...) {
       i = "If you continue to see this message, please email support@ala.org.au."
     )
     inform(bullets)
-    return(set_galah_object_class(new_class = "ala_id"))
+    df <- tibble()
+    attr(df, "call") <- "ala_id"
+    return(df)
   }else{
-    set_galah_object_class(matches, new_class = "ala_id")
+    attr(matches, "call") <- "ala_id"
+    return(matches)
   } 
 }
 

R/utilities_internal.R

@@ -80,15 +80,6 @@ fix_assertion_cols <- function(df, assertion_cols) {
   df
 }
 
-# ensure outputs are tibbles, with an appropriate class
-# if no object is given, create an empty tibble with that class
-set_galah_object_class <- function(input, new_class){
-  if(missing(input)){input <- tibble()}
-  if(!is_tibble(input)){input <- as_tibble(input)}
-  class(input) <- append(class(input), new_class)
-  input
-}
-
 
 ##----------------------------------------------------------------
 ##                   Parsing functions                          --

tests/testthat/test-deprecated_functions.R

@@ -15,9 +15,8 @@ test_that("select_columns is deprecated", {
     deprecated <- select_columns(eventDate)
     correct <- structure(tibble(name = "eventDate",
                                 type = "field"))
-    class(correct) <- append(class(correct), "galah_select")
     expect_equal(deprecated, correct)
-    expect_s3_class(deprecated, "galah_select")
+    expect_equal(attr(deprecated, "call"), "galah_select")
   })
 })
 

tests/testthat/test-galah_filter.R

@@ -75,78 +75,78 @@ test_that("galah_filter treats commas and '&' the same way", {
 
 test_that("galah_filter handles numeric queries for text fields", {             
   filters <- galah_filter(cl22 >= "Tasmania")
-  expect_s3_class(filters, c("data.frame", "galah_filter"))
+  expect_equal(attr(filters, "call"), "galah_filter")
 })
 
 test_that("galah_filter handles OR statements", {    
   filters <- galah_filter(year == 2010 | year == 2021)
-  expect_s3_class(filters, c("data.frame", "galah_filter"))
+  expect_equal(attr(filters, "call"), "galah_filter")
 })
 
 test_that("galah_filter handles exclusion", {   
   filters <- galah_filter(year >= 2010, year != 2021)
   expect_equal(nrow(filters), 2)
-  expect_s3_class(filters, c("data.frame", "galah_filter"))
+  expect_equal(attr(filters, "call"), "galah_filter")
 })
 
 test_that("galah_filter handles three terms at once", {    
   filters <- galah_filter(
     basisOfRecord == "HumanObservation",
     year >= 2010,
     stateProvince == "New South Wales")
-  expect_s3_class(filters, c("data.frame", "galah_filter"))
+  expect_equal(attr(filters, "call"), "galah_filter")
   expect_equal(nrow(filters),3)
 })
 
 test_that("galah_filter treats `c()` as an OR statement", {
   filters <- galah_filter(year == c(2010, 2021))
-  expect_s3_class(filters, c("data.frame", "galah_filter"))
+  expect_equal(attr(filters, "call"), "galah_filter")
   expect_equal(nrow(filters), 1)
 })
 
 test_that("galah_filter can take an object as a field", {  
   field <- "year"
   filters <- galah_filter(field == 2010)
-  expect_s3_class(filters, c("data.frame", "galah_filter"))
+  expect_equal(attr(filters, "call"), "galah_filter")
   expect_equal(nrow(filters), 1)
   expect_true(grepl("year", filters$query))
 })
 
 test_that("galah_filter can take an object as a value", { 
   value <- "2010"
   filters <- galah_filter(year == value)
-  expect_s3_class(filters, c("data.frame", "galah_filter"))
+  expect_equal(attr(filters, "call"), "galah_filter")
   expect_equal(nrow(filters), 1)
   expect_match(filters$query, "(year:\"2010\")")
 })
 
 test_that("galah_filter can take an object with length >1 as a value", { 
   years <- c(2010, 2021)
   filters <- galah_filter(year == years)
-  expect_s3_class(filters, c("data.frame", "galah_filter"))
+  expect_equal(attr(filters, "call"), "galah_filter")
   expect_equal(nrow(filters), 1)
   expect_true(grepl("2010", filters$query))
 })
 
 test_that("galah_filter can take an object as an equation", { 
   input_text <- "year == 2010"
   filters <- galah_filter(input_text)
-  expect_s3_class(filters, c("data.frame", "galah_filter"))
+  expect_equal(attr(filters, "call"), "galah_filter")
   expect_equal(nrow(filters), 1)
   expect_true(grepl("2010", filters$query))
 })
 
 test_that("galah_filter can take an object from a list", { 
   input <- list("year == 2010")
   filters <- galah_filter(input[[1]])
-  expect_s3_class(filters, c("data.frame", "galah_filter"))
+  expect_equal(attr(filters, "call"), "galah_filter")
   expect_equal(nrow(filters), 1)
   expect_true(grepl("2010", filters$query))
 })
 
 test_that("galah_filter can accept an equation built with `paste`", { 
   filters <- galah_filter(paste("year", "2010", sep = " == "))
-  expect_s3_class(filters, c("data.frame", "galah_filter"))
+  expect_equal(attr(filters, "call"), "galah_filter")
   expect_equal(nrow(filters), 1)
   expect_true(grepl("2010", filters$query))
 })
@@ -156,14 +156,14 @@ test_that("galah_filter can accept an equation built with `paste`", {
 # field <- "year"
 # value <- "2010"
 # filters <- galah_filter("field == value")
-# expect_s3_class(filters, c("data.frame", "galah_filter"))
+# expect_equal(attr(filters, "call"), "galah_filter")
 # expect_equal(nrow(filters), 1)
 # expect_true(grepl("2010", filters$query))
 
 test_that("galah_filter handles taxonomic queries", {
   # ensure a taxonomic query to galah_filter works
   filters <- galah_filter(taxonConceptID == search_taxa("Animalia")$taxon_concept_id)
-  expect_s3_class(filters, c("data.frame", "galah_filter"))
+  expect_equal(attr(filters, "call"), "galah_filter")
   expect_equal(nrow(filters), 1)
   expect_false(grepl("search_taxa", filters$query))
 })
@@ -172,7 +172,7 @@ test_that("galah_filter handles taxonomic exclusions", {
   filters <- galah_filter(
     taxonConceptID == search_taxa("Animalia")$taxon_concept_id,
     taxonConceptID != search_taxa("Chordata")$taxon_concept_id)
-  expect_s3_class(filters, c("data.frame", "galah_filter"))
+  expect_equal(attr(filters, "call"), "galah_filter")
   expect_equal(nrow(filters), 2)
   expect_false(any(grepl("search_taxa", filters$query)))
 })