Dev

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: galah
 Type: Package
 Title: Biodiversity Data from the GBIF Node Network
-Version: 2.0.0
+Version: 2.0.1
 Authors@R: 
     c(person(given = "Martin",
              family = "Westgate",

NAMESPACE

@@ -5,23 +5,23 @@ S3method(arrange,metadata_request)
 S3method(collapse,data_request)
 S3method(collapse,files_request)
 S3method(collapse,metadata_request)
+S3method(collect,computed_query)
 S3method(collect,data_request)
 S3method(collect,files_request)
 S3method(collect,metadata_request)
 S3method(collect,query)
-S3method(collect,query_set)
 S3method(compute,data_request)
 S3method(compute,files_request)
 S3method(compute,metadata_request)
 S3method(compute,query)
-S3method(compute,query_set)
 S3method(count,data_request)
 S3method(filter,data_request)
 S3method(filter,files_request)
 S3method(filter,metadata_request)
 S3method(group_by,data_request)
 S3method(identify,data_request)
 S3method(identify,metadata_request)
+S3method(print,computed_query)
 S3method(print,data_request)
 S3method(print,files_request)
 S3method(print,galah_config)
@@ -139,6 +139,7 @@ importFrom(httr2,req_body_raw)
 importFrom(httr2,req_error)
 importFrom(httr2,req_headers)
 importFrom(httr2,req_perform)
+importFrom(httr2,req_timeout)
 importFrom(httr2,request)
 importFrom(httr2,resp_body_json)
 importFrom(httr2,resp_body_string)

NEWS.md

@@ -1,3 +1,16 @@
+# galah 2.0.1
+
+### Minor improvements
+`collapse()` now returns a `query` object, rather than a `query_set`, 
+and gains a `.expand` argument to optionally append a `query_set` for debugging
+purposes (#217).
+
+### Bug fixes
+* Avoid triggering multiple errors when galah_identify() returns no matched taxa (#219)
+* Improve clarity of quick start guide vignette (#221)
+* show_values() no longer truncates rows to 30 (#222)
+* Column ID name returned by search_all(lists) now matches the correct field ID for galah_filter() (#225)
+
 # galah 2.0.0
 
 ### Object-oriented programming

R/atlas_media.R

@@ -114,10 +114,7 @@ atlas_media <- function(request = NULL,
     present_fields <- media_fields
   # if `select` is present, ensure that at least one 'media' field is requested
   }else{
-    # new check using compute_checks()
-    x <- collapse(.query) |>
-      build_checks() |>
-      compute_checks()
+    x <- collapse(.query)
 
     # now check whether valid fields are present
     selected_fields <- x$url |>

R/build_checks.R

@@ -0,0 +1,62 @@
+#' Internal function to build necessary metadata into a single object
+#' I.e. to parse a `query_set` object within `collapse()`
+#' @noRd
+#' @keywords Internal
+build_checks <- function(.query){
+  # get basic description of `query_set` object
+  n <- length(.query)
+  names_vec <- unlist(lapply(.query, function(a){a$type}))
+  # look for any `data`
+  data_lookup <- grepl("^data", names_vec)
+  if(any(data_lookup)){
+    data_names <- names_vec[data_lookup]
+    # parse any `metadata`
+    metadata_results <- parse_metadata(names_vec, .query)
+    # parse `data`, including supplied metadata
+    # this assumes only one `data` field is available per `query_set`
+    .query[[which(data_lookup)]] |>
+      add_metadata(metadata_results)     
+  }else if(any(names_vec %in% c("metadata/fields-unnest", 
+                                "metadata/profiles-unnest",
+                                "metadata/taxa-unnest"))){
+    # this code accounts for `unnest` functions that require lookups
+    # metadata/fields-unnest calls check_fields(), requiring fields and assertions
+    # metadata/profiles-unnest calls profile_short_name(), which requires profiles
+    if(length(.query) > 1){
+      metadata_results <- parse_metadata(names_vec, .query)
+      .query[[2]] |>
+        add_metadata(metadata_results)
+    }else{
+      .query[[1]]
+    }
+  }else{ 
+    # if no metadata are needed, return .query unaltered
+    .query[[1]]
+  }
+}
+
+#' Internal function to parse metadata
+#' @noRd
+#' @keywords Internal
+parse_metadata <- function(names_vec, .query){
+  metadata_lookup <- grepl("^metadata", names_vec) &
+    !grepl("-unnest$", names_vec) # unnest functions only parse in collect()
+  if(any(metadata_lookup)){
+    metadata_names <- names_vec[metadata_lookup]
+    metadata_results <- lapply(.query[metadata_lookup], collect)
+    names(metadata_results) <- metadata_names   
+    metadata_results
+  }else{
+    NULL
+  }
+}
+
+#' Internal function to pass metadata to `collapse()` functions
+#' called by `compute.query_set()`
+#' @noRd
+#' @keywords Internal
+add_metadata <- function(query, meta){
+  result <- c(query, meta)
+  class(result) <- "query"
+  return(result)
+}

R/build_query_set.R

@@ -0,0 +1,134 @@
+#' Internal function to build a `query_set` object 
+#' for object of class `data_request`
+#' @noRd
+#' @keywords Internal
+build_query_set_data <- function(x, mint_doi, ...){
+  if(!missing(mint_doi)){
+    x$mint_doi <- mint_doi
+  }
+  # x$type <- check_type(x$type) # needed?
+  # handle sending dois via `filter()`
+  # important this happens first, as it affects `type` which affects later code
+  variables <- x$filter$variable
+  if(!is.null(variables)){
+    if(length(variables) == 1 & variables[1] == "doi"){
+      x$type <- "occurrences-doi"
+    }
+  }
+  # handle `run_checks`
+  fields_absent <- lapply(
+    x[c("arrange", "filter", "select", "group_by")],
+    is.null
+  ) |>
+    unlist()
+  if (pour("package", "run_checks") & x$type != "occurrences-doi") {
+    # add check here to see whether any filters are specified
+    # it is possible to only call `identify()`, for example
+    if (any(!fields_absent) | x$type %in% c("species-count", "species")) {
+      result <- list(collapse_fields(), collapse_assertions())
+    } else {
+      # for living atlases, we need `collapse_fields()` to check the `lsid` field
+      # this isn't required for GBIF which doesn't use `fq` for taxon queries
+      if(!is.null(x$identify) &!is_gbif()){
+        result <- list(collapse_fields())
+      }else{
+        result <- list()
+      }
+    }
+    if (x$type %in% c("occurrences", "media", "species") &
+        atlas_supports_reasons_api()) {
+      result[[(length(result) + 1)]] <- collapse_reasons()
+    }
+  } else { # if select is required, we need fields even if `run_checks == FALSE`
+    if(!fields_absent[["select"]] | x$type %in% c("occurrences", "species")){
+      result <- list(collapse_fields(), collapse_assertions())
+    }else{
+      result <- list() 
+    }
+  }
+  # handle `identify()`
+  if(!is.null(x$identify) & x$type != "occurrences-doi"){
+    result[[(length(result) + 1)]] <- collapse_taxa(list(identify = x$identify))
+  }
+  # handle `apply_profile()`
+  if(!is.null(x$data_profile)){
+    result[[(length(result) + 1)]] <- collapse_profiles()
+  }
+  # handle query
+  result[[(length(result) + 1)]] <- switch(
+    x$type,
+    "occurrences" = collapse_occurrences(x),
+    "occurrences-count" = collapse_occurrences_count(x),
+    "occurrences-doi" = collapse_occurrences_doi(x),
+    "species" = collapse_species(x),
+    "species-count" = collapse_species_count(x),
+    abort("unrecognised 'type'"))
+  class(result) <- "query_set"
+  result
+}
+
+#' Internal function to build a `query_set` object 
+#' for object of class `metadata_request`
+#' @noRd
+#' @keywords Internal
+build_query_set_metadata <- function(x, ...){
+  if(pour("package", "run_checks")){
+    result <- switch(x$type, 
+                     "fields-unnest" = list(collapse_fields()),
+                     "profiles-unnest" = list(collapse_profiles()),
+                     list())
+  }else{
+    result <- list()
+  }
+  if(grepl("-unnest$", x$type)){
+    if(x$type == "taxa-unnest"){
+      # identify() calls must be parsed, irrespective of `run_checks` (which is parsed above)
+      if(!is.null(x$identify)){
+        result[[(length(result) + 1)]] <- collapse_taxa(x)
+      }
+      if(is.null(x$identify) & is.null(x$filter)){
+        abort("Requests of type `taxa-unnest` must also supply one of `filter()` or `identify()`.")
+      }
+    }else if(is.null(x$filter)){
+      current_type <- x$type
+      bullets <- glue("Requests of type `{current_type}` containing `unnest` must supply `filter()`.")
+      abort(bullets)
+    }
+  }
+  result[[(length(result) + 1)]] <- switch(x$type,
+                                           "apis" = collapse_apis(),
+                                           "assertions" = collapse_assertions(),
+                                           "atlases" = collapse_atlases(),
+                                           "collections" = collapse_collections(x),
+                                           "datasets" = collapse_datasets(x),
+                                           "fields" = collapse_fields(),
+                                           "fields-unnest" = collapse_fields_unnest(x),
+                                           "licences" = collapse_licences(),
+                                           "lists" = collapse_lists(x),
+                                           "lists-unnest" = collapse_lists_unnest(x),
+                                           "media" = collapse_media(x),
+                                           "profiles" = collapse_profiles(),
+                                           "profiles-unnest" = collapse_profiles_unnest(x),
+                                           "providers" = collapse_providers(x),
+                                           "ranks" = collapse_ranks(),
+                                           "reasons" = collapse_reasons(),
+                                           "taxa" = collapse_taxa(x),
+                                           "taxa-unnest" = collapse_taxa_unnest(x),
+                                           "identifiers" = collapse_identifiers(x),
+                                           abort("unrecognised 'type'")
+  )
+  class(result) <- "query_set"
+  result
+}
+
+#' Internal function to build a `query_set` object 
+#' for object of class `files_request`
+#' @noRd
+#' @keywords Internal
+build_query_set_files <- function(x, ..., thumbnail){
+  result <- list(switch(x$type,
+                        "media" = collapse_media_files(x, thumbnail = thumbnail)
+  ))
+  class(result) <- "query_set"
+  result
+}

R/check.R

@@ -359,14 +359,20 @@ check_identifiers_gbif_predicates <- function(.query){
 #' @importFrom stringr str_replace_all
 #' @noRd
 #' @keywords Internal
-check_identifiers_la <- function(.query){
+check_identifiers_la <- function(.query, error_call = caller_env()){
   url <- url_parse(.query$url[1]) # FIXME: test if every >1 urls here
   queries <- url$query
   if(!is.null(queries$fq)){
     if(grepl("(`TAXON_PLACEHOLDER`)", queries$fq)){
       metadata_lookup <- grepl("^metadata/taxa", names(.query))
       if(any(metadata_lookup)){
         identifiers <- .query[[which(metadata_lookup)[1]]]
+
+        # End query early when no taxonomic search terms were matched
+        if (nrow(identifiers) > 0 && !("taxon_concept_id" %in% colnames(identifiers))) {
+          abort("No valid taxonomic identifiers detected.", call = error_call)
+        }
+
         taxa_ids <- build_taxa_query(identifiers$taxon_concept_id)
         queries$fq <- str_replace_all(queries$fq, 
                                       "\\(`TAXON_PLACEHOLDER`\\)", 

R/check_queue.R

@@ -6,11 +6,11 @@ check_queue <- function(.query, wait = FALSE){
   if(.query$status == "incomplete"){
     download_response <- c(list(type = .query$type),
                            check_occurrence_status(.query))
-    class(download_response) <- "query"
+    class(download_response) <- "computed_query"
     if(wait){
       download_response <- c(list(type = .query$type),
                              check_queue_loop(.query))
-      class(download_response) <- "query"
+      class(download_response) <- "computed_query"
       download_response
     }else{
       download_response