R/collect_occurrences.R

In galah: Biodiversity Data from the GBIF Node Network

#' workhorse function to get occurrences from an atlas
#' @param .query an object of class `data_response`, created using 
#' `compute.data_request()`
#' @param wait logical; should we ping the API until successful? Defaults to 
#' FALSE
#' @param file character; optional name for the downloaded file. Defaults to 
#' `data` followed by the system time in `%Y-%m-%d_%H-%M-%S` format, with a 
#' `.zip` suffix.
#' @noRd
#' @keywords Internal
collect_occurrences <- function(.query, 
                                wait, 
                                file = NULL,
                                error_call = rlang::caller_env()){
  switch(.query$atlas,
         "Austria" = collect_occurrences_direct(.query,
                                                file = file,
                                                call = error_call),
         collect_occurrences_default(.query,
                                     wait = wait,
                                     file = file,
                                     call = error_call))
}

#' Internal function to `collect_occurrences()` for UK
#' @noRd
#' @keywords Internal
collect_occurrences_direct <- function(.query, file, call){
  .query$download <- TRUE
  .query$file <- check_download_filename(file)
  query_API(.query)
  result <- read_zip(.query$file)
  if(is.null(result)){
    download_failed_message(call = call)
  }else{
    result
  }
}

#' Internal function to `collect_occurrences()` for living atlases
#' @noRd
#' @keywords Internal
collect_occurrences_default <- function(.query, wait, file, call){

  # check queue
  download_response <- check_queue(.query, wait = wait)
  if(is.null(download_response)){
    cli::cli_abort("No response from selected atlas.",
                   call = call)
  }
  # get data
  if(potions::pour("package", "verbose", .pkg = "galah") &
     download_response$status == "complete") {
    cli::cli_progress_step("Downloading")
  }
  # sometimes lookup info critical, but not others - unclear when/why!
  if(any(names(download_response) == "download_url")){
    new_object <- list(type = "data/occurrences",
                       atlas = .query$atlas,
                       url = download_response$download_url,
                       download = TRUE,
                       file = check_download_filename(file)) |>
      as_query()
    # run downloads
    query_API(new_object)
    # import
    result <- read_zip(new_object$file)
  }else{
    return(download_response) 
  }
  # handle result
  if(is.null(result)){
    download_failed_message(call = call)
  }else{
    result <- result |>
      check_field_identities(.query, error_call = call) |>
      check_media_cols()  # check for, and then clean, media info

    # exception for GBIF to post-process `select()`
    if(.query$atlas == "Global"){
      result <- parse_select(result, .query)
    }

    # exception for GBIF to ensure DOIs are preserved
    if(!is.null(download_response$doi)){
      # NOTE: GBIF documents DOIs in download response status url (it used to be automatically appended)
      #       We extract and preserve this info for the user, as of 2025-06-10
      doi <- download_response$doi
      attr(result, "doi") <- glue::glue("https://doi.org/{doi}")
    }
    if(!is.null(.query$search_url)){
      attr(result, "search_url") <- .query$search_url
    }
    result
  }
}

#' Subset of collect for a doi.
#' @param .query An object of class `data_request`
#' @noRd
#' @keywords Internal
collect_occurrences_doi <- function(.query, 
                                    file = NULL, 
                                    call) {
  .query$file <- check_download_filename(file)
  query_API(.query)
  result <- read_zip(.query$file)
  if(is.null(result)){
    download_failed_message(call = call)
  }else{
    # first see if DOI is returned in the API call
    if(!is.null(.query$doi)){
      attr(result, "doi") <- glue::glue("https://doi.org/{.query$doi}")
    }
    result
  }
}

#' collect type `data/occurrences-glimpse`
#' @noRd
#' @keywords Internal
collect_occurrences_glimpse <- function(.query){
  if(.query$atlas == "Global"){
    collect_occurrences_glimpse_gbif(.query)
  }else{
    collect_occurrences_glimpse_la(.query)
  }
}

#' collect type `data/occurrences-glimpse` for GBIF
#' @noRd
#' @keywords Internal
collect_occurrences_glimpse_gbif <- function(.query){
  result <- query_API(.query)

  # convert to tibble
  df <- result |>
    purrr::pluck("results") |>
    purrr::map(tidy_list_columns) |>
    dplyr::bind_rows() |>
    parse_select(.query)
  attr(df, "total_n") <- result$count

   # assign new object for bespoke printing
  if(tibble::is_tibble(df)){
    structure(df, 
              class = c("occurrences_glimpse", "tbl_df", "tbl", "data.frame")) 
  }else{
    df # not sure what use case this is, but probably NULL
  }
}

#' collect type `data/occurrences-glimpse` for living atlases
#' @noRd
#' @keywords Internal
collect_occurrences_glimpse_la <- function(.query){
  result <- query_API(.query)

  # pull required info from API into a tibble
  df <- result |>
    purrr::pluck("occurrences") |>
    purrr::map(build_tibble_from_nested_list) |>
    dplyr::bind_rows()

   ## OLD CODE
   ## non-standard fields are nested within `otherProperties`
   ## extract these
   # purrr::map(\(a){
   #   if(any(names(a) == "otherProperties")){
   #     c(a[names(a) != "otherProperties"],
   #       a[["otherProperties"]])
   #   }else{
   #     a
   #   }
   # })
  
  attr(df, "total_n") <- result$totalRecords

  # assign new object for bespoke printing
  if(tibble::is_tibble(df)){
    structure(df, 
              class = c("occurrences_glimpse", "tbl_df", "tbl", "data.frame")) 
  }else{
    df # not sure what use case this is, but probably NULL
  }
}

#' collect type `data/occurrences-describe`
#' @noRd
#' @keywords Internal
collect_occurrences_describe <- function(.query){

  if(!is.null(.query$data)){
    result <- retrieve_internal_data(.query) |>
      dplyr::filter(!is.na(.data$id))
  }else{
    result <- query_API(.query) |>
      dplyr::bind_rows() |>
      dplyr::filter(!is.na(.data$name)) |>
      # below here for consistency with `collect_fields()`
      dplyr::filter(.data$stored == TRUE) |>
      dplyr::mutate(id = .data$name) |>
      dplyr::rename_with(camel_to_snake_case) |>
      dplyr::bind_rows(galah_internal_archived$media,
                       galah_internal_archived$other) |>
      dplyr::distinct(.data$id, .keep_all = TRUE)
     
    # add caching here
    result_df <- update_attributes(result,
                                   type = "fields",
                                   atlas = .query$atlas)
    update_cache(fields = result_df)
  }

  # create a 'fake' data.frame to run .query$select on
  df <- matrix(data = NA, 
               nrow = 0,
               ncol = nrow(result),
               dimnames = list(c(), 
                               dplyr::pull(result, .data$id))) |>
    as.data.frame()

  # use this df to parse user-requested `select()` function`
  keep_names <- parse_select_occurrences(.query, df)
    
  # keep only those rows that correspond to user-requested names
  result |>
    dplyr::filter(.data$id %in% keep_names) |>
    dplyr::select("id", "description", "data_type")

}

#' Download failed message
#' @noRd
#' @keywords Internal
download_failed_message <- function(call){
  c("Download failed.",
    i = "This usually suggests a problem with the download itself, rather than the API.",
    i = "Consider checking that a file has been created in the expected location.") |>
    cli::cli_abort(call = call)
}