diff --git a/DESCRIPTION b/DESCRIPTION index 52012784..cb512ca5 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: etn Title: Access Data from the European Tracking Network -Version: 2.1.0 +Version: 3.0.0.9000 Authors@R: c( person("Peter", "Desmet", email = "peter.desmet@inbo.be", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-8442-8025")), @@ -25,11 +25,15 @@ Imports: DBI, dplyr, glue, + httr, jsonlite, + lifecycle, lubridate, methods, odbc, + purrr, readr, + rlang, stringr Suggests: formattable, @@ -37,10 +41,12 @@ Suggests: kableExtra, knitr, rmarkdown, - testthat, - tidyr + testthat (>= 3.0.0), + tidyr, + withr LazyData: true Encoding: UTF-8 VignetteBuilder: knitr Roxygen: list(markdown = TRUE) -RoxygenNote: 7.2.2 +RoxygenNote: 7.2.3 +Config/testthat/edition: 3 diff --git a/NAMESPACE b/NAMESPACE index 86e661cf..e18d511b 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,6 +1,5 @@ # Generated by roxygen2: do not edit by hand -export(connect_to_etn) export(download_acoustic_dataset) export(get_acoustic_deployments) export(get_acoustic_detections) @@ -9,10 +8,6 @@ export(get_acoustic_receivers) export(get_animal_projects) export(get_animals) export(get_cpod_projects) -export(get_deployments) -export(get_detections) -export(get_projects) -export(get_receivers) export(get_tags) export(list_acoustic_project_codes) export(list_acoustic_tag_ids) @@ -20,11 +15,9 @@ export(list_animal_ids) export(list_animal_project_codes) export(list_cpod_project_codes) export(list_deployment_ids) -export(list_network_project_codes) export(list_receiver_ids) export(list_scientific_names) export(list_station_names) -export(list_tag_ids) export(list_tag_serial_numbers) export(list_values) export(write_dwc) @@ -33,3 +26,4 @@ importFrom(dplyr,.data) importFrom(dplyr,distinct) importFrom(dplyr,filter) importFrom(dplyr,pull) +importFrom(lifecycle,deprecated) diff --git a/NEWS.md b/NEWS.md new file mode 100644 index 00000000..293c6a13 --- /dev/null +++ b/NEWS.md @@ -0,0 +1,4 @@ +# etn 3.0.0 + +* Added a `NEWS.md` file to track changes to the package. +* Deprecated functions `get_deployments()`, `get_detections()`, `get_projects()`, `get_receivers()`, `list_network_project_codes()` and `list_tag_ids()` are now end of life and no longer included in etn 3.0.0 diff --git a/R/connect_to_etn.R b/R/connect_to_etn.R index e8ae2fb3..c892fe22 100644 --- a/R/connect_to_etn.R +++ b/R/connect_to_etn.R @@ -1,13 +1,13 @@ #' Connect to the ETN database #' -#' Connect to the ETN database using username and password. +#' `r lifecycle::badge("deprecated")` +#' Connect to the ETN database using username and password. #' #' @param username Character. Username to use for the connection. #' @param password Character. Password to use for the connection. #' #' @return ODBC connection to ETN database. #' -#' @export #' #' @examples #' \dontrun{ diff --git a/R/download_acoustic_dataset.R b/R/download_acoustic_dataset.R index 634b4d27..b9e07144 100644 --- a/R/download_acoustic_dataset.R +++ b/R/download_acoustic_dataset.R @@ -76,12 +76,16 @@ #' #> In download_acoustic_dataset(animal_project_code = "2012_leopoldkanaal") : #' #> Found tags associated with multiple animals: 1145373 #' } -download_acoustic_dataset <- function(connection = con, - animal_project_code, +download_acoustic_dataset <- function(animal_project_code, scientific_name = NULL, - directory = animal_project_code) { - # Check connection - check_connection(connection) + directory = animal_project_code, + api = TRUE, + connection) { + # Check arguments + # The connection argument has been depreciated + if (lifecycle::is_present(connection)) { + deprecate_warn_connection() + } # Check animal_project_code assertthat::assert_that( @@ -90,7 +94,7 @@ download_acoustic_dataset <- function(connection = con, ) animal_project_code <- check_value( animal_project_code, - list_animal_project_codes(connection), + list_animal_project_codes(api = api), "animal_project_code", lowercase = TRUE ) @@ -99,7 +103,7 @@ download_acoustic_dataset <- function(connection = con, if (!is.null(scientific_name)) { scientific_name <- check_value( scientific_name, - list_scientific_names(connection), + list_scientific_names(api = api), "scientific_name" ) } @@ -112,7 +116,7 @@ download_acoustic_dataset <- function(connection = con, message("* (1/6): downloading animals.csv") # Select on animal_project_code and scientific_name animals <- get_animals( - connection = connection, + api = api, animal_project_code = animal_project_code, scientific_name = scientific_name ) @@ -132,7 +136,7 @@ download_acoustic_dataset <- function(connection = con, unlist() %>% unique() tags <- get_tags( - connection = connection, + api = api, tag_serial_number = tag_serial_numbers ) readr::write_csv(tags, paste(directory, "tags.csv", sep = "/"), na = "") @@ -141,7 +145,7 @@ download_acoustic_dataset <- function(connection = con, message("* (3/6): downloading detections.csv") # Select on animal_project_code and scientific_name detections <- get_acoustic_detections( - connection = connection, + api = api, animal_project_code = animal_project_code, scientific_name = scientific_name, limit = FALSE @@ -163,7 +167,7 @@ download_acoustic_dataset <- function(connection = con, pull() %>% sort() deployments <- get_acoustic_deployments( - connection = connection, + api = api, acoustic_project_code = acoustic_project_codes, open_only = FALSE ) @@ -181,7 +185,7 @@ download_acoustic_dataset <- function(connection = con, distinct(.data$receiver_id) %>% pull() receivers <- get_acoustic_receivers( - connection = connection, + api = api, receiver_id = receiver_ids ) readr::write_csv(receivers, paste(directory, "receivers.csv", sep = "/"), na = "") diff --git a/R/etn-deprecated.R b/R/etn-deprecated.R deleted file mode 100644 index d6a4b60b..00000000 --- a/R/etn-deprecated.R +++ /dev/null @@ -1,62 +0,0 @@ -#' Deprecated functions in etn -#' -#' The functions listed below are deprecated or renamed and will be defunct in -#' the near future. -#' -#' @name etn-deprecated -#' @keywords internal -NULL - -#' @rdname etn-deprecated -#' @export -get_deployments <- function(connection = con, network_project_code = NULL, ...) { - .Deprecated("get_acoustic_deployments") - get_acoustic_deployments(connection, acoustic_project_code = network_project_code, ...) -} - -#' @rdname etn-deprecated -#' @export -get_detections <- function(connection = con, tag_id = NULL, network_project_code = NULL, ...) { - .Deprecated("get_acoustic_detections") - get_acoustic_detections(connection, acoustic_tag_id = tag_id, acoustic_project_code = network_project_code, ...) -} - -#' @rdname etn-deprecated -#' @export -get_projects <- function(connection = con, project_type, application_type) { - .Deprecated("get_animal_projects, get_acoustic_projects or get_cpod_projects") - if (!missing("project_type")) { - if (project_type == "network") { - get_acoustic_projects(connection) - } else { - get_animal_projects(connection) - } - } else if (!missing("application_type")) { - if (application_type == "cpod") { - get_cpod_projects(connection) - } - } else { - get_animal_projects(connection) - } -} - -#' @rdname etn-deprecated -#' @export -get_receivers <- function(...) { - .Deprecated("get_acoustic_receivers") - get_acoustic_receivers(...) -} - -#' @rdname etn-deprecated -#' @export -list_network_project_codes <- function(...) { - .Deprecated("list_acoustic_project_codes") - list_acoustic_project_codes(...) -} - -#' @rdname etn-deprecated -#' @export -list_tag_ids <- function(...) { - .Deprecated("list_acoustic_tag_ids") - list_acoustic_tag_ids(...) -} diff --git a/R/etn.R b/R/etn.R index d9c1f90e..a3c59fdb 100644 --- a/R/etn.R +++ b/R/etn.R @@ -1,3 +1,8 @@ #' @importFrom dplyr %>% .data distinct filter pull #' @keywords internal "_PACKAGE" + +## usethis namespace: start +#' @importFrom lifecycle deprecated +## usethis namespace: end +NULL diff --git a/R/get_acoustic_deployments.R b/R/get_acoustic_deployments.R index 8b0e9e4b..bc498f5f 100644 --- a/R/get_acoustic_deployments.R +++ b/R/get_acoustic_deployments.R @@ -40,12 +40,36 @@ #' #' # Get acoustic deployments for two specific stations #' get_acoustic_deployments(con, station_name = c("de-9", "de-10")) -get_acoustic_deployments <- function(connection = con, - deployment_id = NULL, +get_acoustic_deployments <- function(deployment_id = NULL, receiver_id = NULL, acoustic_project_code = NULL, station_name = NULL, - open_only = FALSE) { + open_only = FALSE, + api = TRUE, + connection) { + # Check arguments + # The connection argument has been depreciated + if (lifecycle::is_present(connection)) { + deprecate_warn_connection() + } + # Either use the API, or the SQL helper. + out <- conduct_parent_to_helpers(api) + return(out) +} + +#' get_acoustic_deployments() sql helper +#' +#' @inheritParams get_acoustic_deployments() +#' @noRd +#' +get_acoustic_deployments_sql <- function(deployment_id = NULL, + receiver_id = NULL, + acoustic_project_code = NULL, + station_name = NULL, + open_only = FALSE) { + # Create connection + connection <- do.call(connect_to_etn, get_credentials()) + # Check connection check_connection(connection) @@ -55,7 +79,7 @@ get_acoustic_deployments <- function(connection = con, } else { deployment_id <- check_value( deployment_id, - list_deployment_ids(connection), + list_deployment_ids(api = FALSE), "receiver_id" ) deployment_id_query <- glue::glue_sql( @@ -70,7 +94,7 @@ get_acoustic_deployments <- function(connection = con, } else { receiver_id <- check_value( receiver_id, - list_receiver_ids(connection), + list_receiver_ids(api = FALSE), "receiver_id" ) receiver_id_query <- glue::glue_sql( @@ -85,7 +109,7 @@ get_acoustic_deployments <- function(connection = con, } else { acoustic_project_code <- check_value( acoustic_project_code, - list_acoustic_project_codes(connection), + list_acoustic_project_codes(api = FALSE), "acoustic_project_code", lowercase = TRUE ) @@ -101,7 +125,7 @@ get_acoustic_deployments <- function(connection = con, } else { station_name <- check_value( station_name, - list_station_names(connection), + list_station_names(api = FALSE), "station_name" ) station_name_query <- glue::glue_sql( @@ -192,9 +216,11 @@ get_acoustic_deployments <- function(connection = con, deployments %>% dplyr::arrange( .data$acoustic_project_code, - factor(.data$station_name, levels = list_station_names(connection)), + factor(.data$station_name, levels = list_station_names(api = FALSE)), .data$deploy_date_time ) - + # Close connection + DBI::dbDisconnect(connection) + # Return acoustic deployments dplyr::as_tibble(deployments) } diff --git a/R/get_acoustic_detections.R b/R/get_acoustic_detections.R index 1157b096..ac498701 100644 --- a/R/get_acoustic_detections.R +++ b/R/get_acoustic_detections.R @@ -74,8 +74,33 @@ #' receiver_id = "VR2W-124070", #' acoustic_project_code = "demer" #' ) -get_acoustic_detections <- function(connection = con, - start_date = NULL, +get_acoustic_detections <- function(start_date = NULL, + end_date = NULL, + acoustic_tag_id = NULL, + animal_project_code = NULL, + scientific_name = NULL, + acoustic_project_code = NULL, + receiver_id = NULL, + station_name = NULL, + limit = FALSE, + api = TRUE, + connection){ + # Check arguments + # The connection argument has been depreciated + if (lifecycle::is_present(connection)) { + deprecate_warn_connection() + } + # Either use the API, or the SQL helper. + out <- conduct_parent_to_helpers(api) + return(out) +} + +#' get_acoustic_detections() sql helper +#' +#' @inheritParams get_acoustic_detections() +#' @noRd +#' +get_acoustic_detections_sql <- function(start_date = NULL, end_date = NULL, acoustic_tag_id = NULL, animal_project_code = NULL, @@ -84,6 +109,8 @@ get_acoustic_detections <- function(connection = con, receiver_id = NULL, station_name = NULL, limit = FALSE) { + # Create connection + connection <- do.call(connect_to_etn, get_credentials()) # Check connection check_connection(connection) @@ -109,7 +136,7 @@ get_acoustic_detections <- function(connection = con, } else { acoustic_tag_id <- check_value( acoustic_tag_id, - list_acoustic_tag_ids(connection), + list_acoustic_tag_ids(api = FALSE), "acoustic_tag_id" ) acoustic_tag_id_query <- glue::glue_sql( @@ -125,7 +152,7 @@ get_acoustic_detections <- function(connection = con, } else { animal_project_code <- check_value( animal_project_code, - list_animal_project_codes(connection), + list_animal_project_codes(api = FALSE), "animal_project_code", lowercase = TRUE ) @@ -141,7 +168,7 @@ get_acoustic_detections <- function(connection = con, } else { scientific_name <- check_value( scientific_name, - list_scientific_names(connection), + list_scientific_names(api = FALSE), "scientific_name" ) scientific_name_query <- glue::glue_sql( @@ -156,7 +183,7 @@ get_acoustic_detections <- function(connection = con, } else { acoustic_project_code <- check_value( acoustic_project_code, - list_acoustic_project_codes(connection), + list_acoustic_project_codes(api = FALSE), "acoustic_project_code", lowercase = TRUE ) @@ -172,7 +199,7 @@ get_acoustic_detections <- function(connection = con, } else { receiver_id <- check_value( receiver_id, - list_receiver_ids(connection), + list_receiver_ids(api = FALSE), "receiver_id" ) receiver_id_query <- glue::glue_sql( @@ -187,7 +214,7 @@ get_acoustic_detections <- function(connection = con, } else { station_name <- check_value( station_name, - list_station_names(connection), + list_station_names(api = FALSE), "station_name" ) station_name_query <- glue::glue_sql( @@ -259,9 +286,14 @@ get_acoustic_detections <- function(connection = con, detections <- detections %>% dplyr::arrange( - factor(.data$acoustic_tag_id, levels = list_acoustic_tag_ids(connection)), + factor(.data$acoustic_tag_id, levels = list_acoustic_tag_ids(api = FALSE)), .data$date_time ) + # Close connection + DBI::dbDisconnect(connection) + + # Return detections dplyr::as_tibble(detections) + } diff --git a/R/get_acoustic_projects.R b/R/get_acoustic_projects.R index d662b5a6..f04b5c0a 100644 --- a/R/get_acoustic_projects.R +++ b/R/get_acoustic_projects.R @@ -21,8 +21,26 @@ #' #' # Get a specific acoustic project #' get_acoustic_projects(con, acoustic_project_code = "demer") -get_acoustic_projects <- function(connection = con, - acoustic_project_code = NULL) { +get_acoustic_projects <- function(acoustic_project_code = NULL, + api = TRUE, + connection){ + # Check arguments + # The connection argument has been depreciated + if (lifecycle::is_present(connection)) { + deprecate_warn_connection() + } + # Either use the API, or the SQL helper. + out <- conduct_parent_to_helpers(api) + return(out) +} +#' get_acoustic_projects() sql helper +#' +#' @inheritParams get_acoustic_projects() +#' @noRd +#' +get_acoustic_projects_sql <- function(acoustic_project_code = NULL) { + # Create connection + connection <- do.call(connect_to_etn, get_credentials()) # Check connection check_connection(connection) @@ -32,7 +50,7 @@ get_acoustic_projects <- function(connection = con, } else { acoustic_project_code <- check_value( acoustic_project_code, - list_acoustic_project_codes(connection), + list_acoustic_project_codes(api = FALSE), "acoustic_project_code", lowercase = TRUE ) @@ -64,5 +82,9 @@ get_acoustic_projects <- function(connection = con, projects %>% dplyr::arrange(.data$project_code) + # Close connection + DBI::dbDisconnect(connection) + + # Return acoustic projects dplyr::as_tibble(projects) } diff --git a/R/get_acoustic_receivers.R b/R/get_acoustic_receivers.R index 67085761..44da5707 100644 --- a/R/get_acoustic_receivers.R +++ b/R/get_acoustic_receivers.R @@ -26,9 +26,24 @@ #' #' # Get a specific acoustic receiver #' get_acoustic_receivers(con, receiver_id = "VR2W-124070") -get_acoustic_receivers <- function(connection = con, - receiver_id = NULL, +get_acoustic_receivers <- function(receiver_id = NULL, + status = NULL, + api = TRUE, + connection){ + # Check arguments + # The connection argument has been depreciated + if (lifecycle::is_present(connection)) { + deprecate_warn_connection() + } + # Either use the API, or the SQL helper. + out <- conduct_parent_to_helpers(api) + return(out) +} + +get_acoustic_receivers_sql <- function(receiver_id = NULL, status = NULL) { + # Create connection + connection <- do.call(connect_to_etn, get_credentials()) # Check connection check_connection(connection) @@ -36,7 +51,7 @@ get_acoustic_receivers <- function(connection = con, if (is.null(receiver_id)) { receiver_id_query <- "True" } else { - valid_receiver_ids <- list_receiver_ids(connection) + valid_receiver_ids <- list_receiver_ids(api = FALSE) check_value(receiver_id, valid_receiver_ids, "receiver_id") receiver_id_query <- glue::glue_sql( "receiver.receiver IN ({receiver_id*})", @@ -112,7 +127,10 @@ get_acoustic_receivers <- function(connection = con, AND {status_query} ", .con = connection) receivers <- DBI::dbGetQuery(connection, query) - + + # Close connection + DBI::dbDisconnect(connection) + # Sort data receivers <- receivers %>% diff --git a/R/get_animal_projects.R b/R/get_animal_projects.R index c66eb619..fd0d3022 100644 --- a/R/get_animal_projects.R +++ b/R/get_animal_projects.R @@ -21,8 +21,27 @@ #' #' # Get a specific animal project #' get_animal_projects(con, animal_project_code = "2014_demer") -get_animal_projects <- function(connection = con, - animal_project_code = NULL) { +get_animal_projects <- function(animal_project_code = NULL, + api = TRUE, + connection){ + # Check arguments + # The connection argument has been depreciated + if (lifecycle::is_present(connection)) { + deprecate_warn_connection() + } + # Either use the API, or the SQL helper. + out <- conduct_parent_to_helpers(api) + return(out) +} + +#' get_animal_projects() sql helper +#' +#' @inheritParams get_animal_projects() +#' @noRd +#' +get_animal_projects_sql <- function(animal_project_code = NULL) { + # Create connection + connection <- do.call(connect_to_etn, get_credentials()) # Check connection check_connection(connection) @@ -32,7 +51,7 @@ get_animal_projects <- function(connection = con, } else { animal_project_code <- check_value( animal_project_code, - list_animal_project_codes(connection), + list_animal_project_codes(api = FALSE), "animal_project_code", lowercase = TRUE ) @@ -58,7 +77,10 @@ get_animal_projects <- function(connection = con, AND {animal_project_code_query} ", .con = connection) projects <- DBI::dbGetQuery(connection, query) - + + # Close connection + DBI::dbDisconnect(connection) + # Sort data projects <- projects %>% diff --git a/R/get_animals.R b/R/get_animals.R index 000e17ec..c1882cab 100644 --- a/R/get_animals.R +++ b/R/get_animals.R @@ -41,11 +41,33 @@ #' #' # Get animals of a specific species from a specific project #' get_animals(con, animal_project_code = "2014_demer", scientific_name = "Rutilus rutilus") -get_animals <- function(connection = con, - animal_id = NULL, +get_animals <- function(animal_id = NULL, tag_serial_number = NULL, animal_project_code = NULL, - scientific_name = NULL) { + scientific_name = NULL, + api = TRUE, + connection) { + # Check arguments + # The connection argument has been depreciated + if (lifecycle::is_present(connection)) { + deprecate_warn_connection() + } + # Either use the API, or the SQL helper. + out <- conduct_parent_to_helpers(api) + return(out) +} + +#' get_animals() sql helper +#' +#' @inheritParams get_animals() +#' @noRd +#' +get_animals_sql <- function(animal_id = NULL, + tag_serial_number = NULL, + animal_project_code = NULL, + scientific_name = NULL) { + # Create connection + connection <- do.call(connect_to_etn, get_credentials()) # Check connection check_connection(connection) @@ -55,7 +77,7 @@ get_animals <- function(connection = con, } else { animal_id <- check_value( animal_id, - list_animal_ids(connection), + list_animal_ids(api = FALSE), "animal_id" ) animal_id_query <- glue::glue_sql( @@ -71,7 +93,7 @@ get_animals <- function(connection = con, } else { animal_project_code <- check_value( animal_project_code, - list_animal_project_codes(connection), + list_animal_project_codes(api = FALSE), "animal_project_code", lowercase = TRUE ) @@ -87,7 +109,7 @@ get_animals <- function(connection = con, } else { tag_serial_number <- check_value( as.character(tag_serial_number), # Cast to character - list_tag_serial_numbers(connection), + list_tag_serial_numbers(api = FALSE), "tag_serial_number" ) tag_serial_number_query <- glue::glue_sql( @@ -102,7 +124,7 @@ get_animals <- function(connection = con, } else { scientific_name <- check_value( scientific_name, - list_scientific_names(connection), + list_scientific_names(api = FALSE), "scientific_name" ) scientific_name_query <- glue::glue_sql( @@ -208,6 +230,9 @@ get_animals <- function(connection = con, ", .con = connection) animals <- DBI::dbGetQuery(connection, query) + # Close connection + DBI::dbDisconnect(connection) + # Collapse tag information, to obtain one row = one animal tag_cols <- animals %>% @@ -231,7 +256,7 @@ get_animals <- function(connection = con, dplyr::arrange( .data$animal_project_code, .data$release_date_time, - factor(.data$tag_serial_number, levels = list_tag_serial_numbers(connection)) + factor(.data$tag_serial_number, levels = list_tag_serial_numbers(api = FALSE)) ) dplyr::as_tibble(animals) # Is already a tibble, but added if code above changes diff --git a/R/get_cpod_projects.R b/R/get_cpod_projects.R index d1c214ca..2fa9fff8 100644 --- a/R/get_cpod_projects.R +++ b/R/get_cpod_projects.R @@ -21,8 +21,27 @@ #' #' # Get a specific animal project #' get_cpod_projects(con, cpod_project_code = "cpod-lifewatch") -get_cpod_projects <- function(connection = con, - cpod_project_code = NULL) { +get_cpod_projects <- function(cpod_project_code = NULL, + api = TRUE, + connection) { + # Check arguments + # The connection argument has been depreciated + if (lifecycle::is_present(connection)) { + deprecate_warn_connection() + } + # Either use the API, or the SQL helper. + out <- conduct_parent_to_helpers(api) + return(out) +} + +#' get_cpod_projects() sql helper +#' +#' @inheritParams get_cpod_projects() +#' @noRd +#' +get_cpod_projects_sql <- function(cpod_project_code = NULL) { + # Create connection + connection <- do.call(connect_to_etn, get_credentials()) # Check connection check_connection(connection) @@ -59,6 +78,9 @@ get_cpod_projects <- function(connection = con, ", .con = connection) projects <- DBI::dbGetQuery(connection, query) + # Close connection + DBI::dbDisconnect(connection) + # Sort data projects <- projects %>% diff --git a/R/get_tags.R b/R/get_tags.R index c136fb67..571c7109 100644 --- a/R/get_tags.R +++ b/R/get_tags.R @@ -37,11 +37,32 @@ #' get_tags(con, tag_serial_number = "1187450") #' get_tags(con, acoustic_tag_id = "A69-1601-16130") #' get_tags(con, acoustic_tag_id = c("A69-1601-16129", "A69-1601-16130")) -get_tags <- function(connection = con, - tag_type = NULL, +get_tags <- function(tag_type = NULL, tag_subtype = NULL, tag_serial_number = NULL, - acoustic_tag_id = NULL) { + acoustic_tag_id = NULL, + api = TRUE, + connection) { + # Check arguments + # The connection argument has been depreciated + if (lifecycle::is_present(connection)) { + deprecate_warn_connection() + } + # Either use the API, or the SQL helper. + out <- conduct_parent_to_helpers(api) + return(out) +} +#' get_tags() sql helper +#' +#' @inheritParams get_tags() +#' @noRd +#' +get_tags_sql <- function(tag_type = NULL, + tag_subtype = NULL, + tag_serial_number = NULL, + acoustic_tag_id = NULL) { + # Create connection + connection <- do.call(connect_to_etn, get_credentials()) # Check connection check_connection(connection) @@ -51,7 +72,7 @@ get_tags <- function(connection = con, } else { tag_serial_number <- check_value( as.character(tag_serial_number), # Cast to character - list_tag_serial_numbers(connection), + list_tag_serial_numbers(api = FALSE), "tag_serial_number" ) tag_serial_number_query <- glue::glue_sql( @@ -96,7 +117,7 @@ get_tags <- function(connection = con, } else { check_value( acoustic_tag_id, - list_acoustic_tag_ids(connection), + list_acoustic_tag_ids(api = FALSE), "acoustic_tag_id" ) acoustic_tag_id_query <- glue::glue_sql( @@ -195,10 +216,13 @@ get_tags <- function(connection = con, ", .con = connection) tags <- DBI::dbGetQuery(connection, query) + # Close connection + DBI::dbDisconnect(connection) + # Sort data tags <- tags %>% - dplyr::arrange(factor(.data$tag_serial_number, levels = list_tag_serial_numbers(connection))) + dplyr::arrange(factor(.data$tag_serial_number, levels = list_tag_serial_numbers(api = FALSE))) dplyr::as_tibble(tags) } diff --git a/R/list_acoustic_project_codes.R b/R/list_acoustic_project_codes.R index 47389cac..215920f9 100644 --- a/R/list_acoustic_project_codes.R +++ b/R/list_acoustic_project_codes.R @@ -6,7 +6,28 @@ #' `project.sql`. #' #' @export -list_acoustic_project_codes <- function(connection = con) { +list_acoustic_project_codes <- function(api = TRUE, + connection) { + # Check arguments + # The connection argument has been depreciated + if (lifecycle::is_present(connection)) { + deprecate_warn_connection() + } + # Either use the API, or the SQL helper. + out <- conduct_parent_to_helpers(api) + return(out) +} + +#' list_acoustic_project_codes() sql helper +#' +#' @inheritParams list_acoustic_project_codes() +#' @noRd +#' +list_acoustic_project_codes_sql <- function(){ + # Create connection + connection <- do.call(connect_to_etn, get_credentials()) + # Check connection + check_connection(connection) project_sql <- glue::glue_sql( readr::read_file(system.file("sql", "project.sql", package = "etn")), .con = connection @@ -17,5 +38,9 @@ list_acoustic_project_codes <- function(connection = con) { ) data <- DBI::dbGetQuery(connection, query) + # Close connection + DBI::dbDisconnect(connection) + + # Return acoustic_project_codes sort(data$project_code) } diff --git a/R/list_acoustic_tag_ids.R b/R/list_acoustic_tag_ids.R index 71d7b0a2..1b96194b 100644 --- a/R/list_acoustic_tag_ids.R +++ b/R/list_acoustic_tag_ids.R @@ -5,7 +5,29 @@ #' @return A vector of all unique `acoustic_tag_id` in `acoustic_tag_id.sql`. #' #' @export -list_acoustic_tag_ids <- function(connection = con) { +list_acoustic_tag_ids <- function(api = TRUE, + connection) { + # Check arguments + # The connection argument has been depreciated + if (lifecycle::is_present(connection)) { + deprecate_warn_connection() + } + # Either use the API, or the SQL helper. + out <- conduct_parent_to_helpers(api) + return(out) +} + +#' list_acoustic_tag_ids() sql helper +#' +#' @inheritParams list_acoustic_tag_ids() +#' @noRd +#' +list_acoustic_tag_ids_sql <- function(){ + # Create connection + connection <- do.call(connect_to_etn, get_credentials()) + # Check connection + check_connection(connection) + acoustic_tag_id_sql <- glue::glue_sql( readr::read_file(system.file("sql", "acoustic_tag_id.sql", package = "etn")), .con = connection @@ -17,5 +39,9 @@ list_acoustic_tag_ids <- function(connection = con) { ", .con = connection) data <- DBI::dbGetQuery(connection, query) + # Close connection + DBI::dbDisconnect(connection) + + # Return acoustic_tag_ids() stringr::str_sort(data$acoustic_tag_id, numeric = TRUE) } diff --git a/R/list_animal_ids.R b/R/list_animal_ids.R index 5b6df64a..62f8b5ad 100644 --- a/R/list_animal_ids.R +++ b/R/list_animal_ids.R @@ -1,16 +1,41 @@ #' List all available animal ids #' -#' @param connection A connection to the ETN database. Defaults to `con`. #' #' @return A vector of all unique `id_pk` present in `common.animal_release`. #' #' @export -list_animal_ids <- function(connection = con) { +list_animal_ids <- function(api = TRUE, + connection) { + # Check arguments + # The connection argument has been depreciated + if (lifecycle::is_present(connection)) { + deprecate_warn_connection() + } + # Either use the API, or the SQL helper. + out <- conduct_parent_to_helpers(api) + return(out) +} + +#' list_animal_ids() sql helper +#' +#' @inheritParams list_animal_ids() +#' @noRd +#' +list_animal_ids_sql <- function() { + # Create connection + connection <- do.call(connect_to_etn, get_credentials()) + # Check connection + check_connection(connection) + query <- glue::glue_sql( "SELECT DISTINCT id_pk FROM common.animal_release", .con = connection ) data <- DBI::dbGetQuery(connection, query) + # Close connection + DBI::dbDisconnect(connection) + + # Return animal ids sort(data$id_pk) } diff --git a/R/list_animal_project_codes.R b/R/list_animal_project_codes.R index ce44a007..40f41316 100644 --- a/R/list_animal_project_codes.R +++ b/R/list_animal_project_codes.R @@ -6,7 +6,29 @@ #' `project.sql`. #' #' @export -list_animal_project_codes <- function(connection = con) { +list_animal_project_codes <- function(api = TRUE, + connection) { + # Check arguments + # The connection argument has been depreciated + if (lifecycle::is_present(connection)) { + deprecate_warn_connection() + } + # Either use the API, or the SQL helper. + out <- conduct_parent_to_helpers(api) + return(out) +} + +#' list_animal_project_codes() sql helper +#' +#' @inheritParams list_animal_project_codes() +#' @noRd +#' +list_animal_project_codes_sql <- function(){ + # Create connection + connection <- do.call(connect_to_etn, get_credentials()) + # Check connection + check_connection(connection) + project_sql <- glue::glue_sql( readr::read_file(system.file("sql", "project.sql", package = "etn")), .con = connection @@ -17,5 +39,9 @@ list_animal_project_codes <- function(connection = con) { ) data <- DBI::dbGetQuery(connection, query) + # Close connection + DBI::dbDisconnect(connection) + + # Return animal_project_codes sort(data$project_code) } diff --git a/R/list_cpod_project_codes.R b/R/list_cpod_project_codes.R index 07d27401..0a32d786 100644 --- a/R/list_cpod_project_codes.R +++ b/R/list_cpod_project_codes.R @@ -6,7 +6,29 @@ #' `project.sql`. #' #' @export -list_cpod_project_codes <- function(connection = con) { +list_cpod_project_codes <- function(api = TRUE, connection){ + # Check arguments + # The connection argument has been depreciated + if (lifecycle::is_present(connection)) { + deprecate_warn_connection() + } + # Either use the API, or the SQL helper. + out <- conduct_parent_to_helpers(api) + return(out) +} + +#' list_cpod_project_codes() sql helper +#' +#' @inheritParams list_cpod_project_codes() +#' @noRd +#' +list_cpod_project_codes_sql <- function() { + + # Create connection + connection <- do.call(connect_to_etn, get_credentials()) + # Check connection + check_connection(connection) + project_query <- glue::glue_sql( readr::read_file(system.file("sql", "project.sql", package = "etn")), .con = connection @@ -17,5 +39,9 @@ list_cpod_project_codes <- function(connection = con) { ) data <- DBI::dbGetQuery(connection, query) + # Close connection + DBI::dbDisconnect(connection) + + # Return cpod project codes sort(data$project_code) } diff --git a/R/list_deployment_ids.R b/R/list_deployment_ids.R index cd4b5a56..988dd1d7 100644 --- a/R/list_deployment_ids.R +++ b/R/list_deployment_ids.R @@ -5,12 +5,37 @@ #' @return A vector of all unique `id_pk` present in `acoustic.deployments`. #' #' @export -list_deployment_ids <- function(connection = con) { +list_deployment_ids <- function(api = TRUE, connection) { + # Check arguments + # The connection argument has been depreciated + if (lifecycle::is_present(connection)) { + deprecate_warn_connection() + } + # Either use the API, or the SQL helper. + out <- conduct_parent_to_helpers(api) + return(out) +} + +#' list_deployment_ids() sql helper +#' +#' @inheritParams list_deployment_ids() +#' @noRd +#' +list_deployment_ids_sql <- function() { + # Create connection + connection <- do.call(connect_to_etn, get_credentials()) + # Check connection + check_connection(connection) + query <- glue::glue_sql( "SELECT DISTINCT id_pk FROM acoustic.deployments", .con = connection ) data <- DBI::dbGetQuery(connection, query) + # Close connection + DBI::dbDisconnect(connection) + + # Return deployment ids stringr::str_sort(data$id, numeric = TRUE) } diff --git a/R/list_receiver_ids.R b/R/list_receiver_ids.R index 7f93a375..55ea1c4c 100644 --- a/R/list_receiver_ids.R +++ b/R/list_receiver_ids.R @@ -5,12 +5,39 @@ #' @return A vector of all unique `receiver` present in `acoustic.receivers`. #' #' @export -list_receiver_ids <- function(connection = con) { +list_receiver_ids <- function(api = TRUE, + connection){ + # Check arguments + # The connection argument has been depreciated + if (lifecycle::is_present(connection)) { + deprecate_warn_connection() + } + # Either use the API, or the SQL helper. + out <- conduct_parent_to_helpers(api) + return(out) +} + + +#' list_receiver_ids() sql helper +#' +#' @inheritParams list_receiver_ids() +#' @noRd +#' +list_receiver_ids_sql <- function(){ + # Create connection + connection <- do.call(connect_to_etn, get_credentials()) + # Check connection + check_connection(connection) + query <- glue::glue_sql( "SELECT DISTINCT receiver FROM acoustic.receivers", .con = connection ) data <- DBI::dbGetQuery(connection, query) + # Close connection + DBI::dbDisconnect(connection) + + # Return receiver_ids stringr::str_sort(data$receiver, numeric = TRUE) } diff --git a/R/list_scientific_names.R b/R/list_scientific_names.R index 42b4d5a4..fb587502 100644 --- a/R/list_scientific_names.R +++ b/R/list_scientific_names.R @@ -1,17 +1,41 @@ #' List all available scientific names #' -#' @param connection A connection to the ETN database. Defaults to `con`. #' #' @return A vector of all unique `scientific_name` present in #' `common.animal_release`. #' #' @export -list_scientific_names <- function(connection = con) { +list_scientific_names <- function(api = TRUE, + connection) { + # Check arguments + # The connection argument has been depreciated + if (lifecycle::is_present(connection)) { + deprecate_warn_connection() + } + # Either use the API, or the SQL helper. + out <- conduct_parent_to_helpers(api) + return(out) +} +#' list_scientific_names() sql helper +#' +#' @inheritParams list_scientific_names() +#' @noRd +#' +list_scientific_names_sql <- function(){ + # Create connection + connection <- do.call(connect_to_etn, get_credentials()) + # Check connection + check_connection(connection) + query <- glue::glue_sql( "SELECT DISTINCT scientific_name FROM common.animal_release", .con = connection ) data <- DBI::dbGetQuery(connection, query) + # Close connection + DBI::dbDisconnect(connection) + + # Return scientific_names sort(data$scientific_name) } diff --git a/R/list_station_names.R b/R/list_station_names.R index 78b9c0d4..0be21816 100644 --- a/R/list_station_names.R +++ b/R/list_station_names.R @@ -6,12 +6,37 @@ #' `acoustic.deployments`. #' #' @export -list_station_names <- function(connection = con) { +list_station_names <- function(api = TRUE, + connection) { + # Check arguments + # The connection argument has been depreciated + if (lifecycle::is_present(connection)) { + deprecate_warn_connection() + } + # Either use the API, or the SQL helper. + out <- conduct_parent_to_helpers(api) + return(out) +} +#' list_station_names() sql helper +#' +#' @inheritParams list_station_names() +#' @noRd +#' +list_station_names_sql <- function(){ + # Create connection + connection <- do.call(connect_to_etn, get_credentials()) + # Check connection + check_connection(connection) + query <- glue::glue_sql( "SELECT DISTINCT station_name FROM acoustic.deployments WHERE station_name IS NOT NULL", .con = connection ) data <- DBI::dbGetQuery(connection, query) + # Close connection + DBI::dbDisconnect(connection) + + # Return station_names stringr::str_sort(data$station_name, numeric = TRUE) } diff --git a/R/list_tag_serial_numbers.R b/R/list_tag_serial_numbers.R index 3730167a..d9432ad1 100644 --- a/R/list_tag_serial_numbers.R +++ b/R/list_tag_serial_numbers.R @@ -6,12 +6,38 @@ #' `common.tag_device`. #' #' @export -list_tag_serial_numbers <- function(connection = con) { +list_tag_serial_numbers <- function(api = TRUE, + connection) { + # Check arguments + # The connection argument has been depreciated + if (lifecycle::is_present(connection)) { + deprecate_warn_connection() + } + # Either use the API, or the SQL helper. + out <- conduct_parent_to_helpers(api) + return(out) +} + +#' list_tag_serial_numbers() sql helper +#' +#' @inheritParams list_tag_serial_numbers() +#' @noRd +#' +list_tag_serial_numbers_sql <- function() { + # Create connection + connection <- do.call(connect_to_etn, get_credentials()) + # Check connection + check_connection(connection) + query <- glue::glue_sql( "SELECT DISTINCT serial_number FROM common.tag_device", .con = connection ) data <- DBI::dbGetQuery(connection, query) + + # Close connection + DBI::dbDisconnect(connection) + # Return tag serial numbers stringr::str_sort(data$serial_number, numeric = TRUE) } diff --git a/R/utils.R b/R/utils.R index de7bd7fe..262d906d 100644 --- a/R/utils.R +++ b/R/utils.R @@ -86,3 +86,268 @@ check_date_time <- function(date_time, date_name = "start_date") { ) as.character(parsed) } + +#' Get the credentials from environment variables, or set them manually +#' +#' By default, it's not necessary to set any values in this function as it's +#' used in the background by other functions. However, if you wish to provide +#' your username and password on a per function basis, this function allows you +#' to do so. +#' +#' @param username ETN Data username, by default read from the environment, but +#' you can set it manually too. +#' @param password ETN Data password, by default read from the environment, but +#' you can set it manually too. +#' @return A string as it is ingested by other functions that need +#' authentication +#' @family helper functions +#' @noRd +get_credentials <- function(username = Sys.getenv("userid"), + password = Sys.getenv("pwd")) { + if (Sys.getenv("userid") == "") { + message("No credentials stored, prompting..") + Sys.setenv(userid = readline(prompt = "Please enter a userid: ")) + Sys.setenv(pwd = askpass::askpass()) + } + # glue::glue('list(username = "{username}", password = "{password}")') + invisible(list(username = username, password = password)) +} + +#' Extract the OCPU temp key from a response object +#' +#' When posting a request to the opencpu api service without the json flag, a +#' response object is returned containing all the generated objects, with a +#' unique temp key in the path. To retrieve these objects in a subsequent GET +#' request, it is convenient to retrieve this temp key from the original +#' response object +#' +#' @param response The response resulting from a POST request to a opencpu api +#' service +#' +#' @return the OCPU temp key to be used as part of a GET request to an opencpu +#' api service +#' @family helper functions +#' @noRd +extract_temp_key <- function(response) { + response %>% + httr::content(as = "text") %>% + stringr::str_extract("(?<=tmp\\/).{15}(?=\\/)") +} + +#' Retrieve the result of a function called to the opencpu api +#' +#' Fetch the result of an API call to OpenCPU +#' +#' This function is used internally to GET an evaluated object from an OpenCPU +#' api, to GET a result, you must of course POST a function call first +#' +#' @param temp_key the temp key returned from the POST request to the API +#' +#' @return the uncompressed object resulting form a GET request to the API +#' @family helper functions +#' @noRd +#' @examples +#' \dontrun{ +#' etn:::extract_temp_key(response) %>% get_val() +#' } +#' +#' # using the opencpu test instance +#' api_url <- "https://cloud.opencpu.org/ocpu/library/stats/R/rnorm" +#' httr::POST(api_url, body = list(n = 10, mean = 5)) %>% +#' extract_temp_key() %>% +#' get_val(api_domain = "https://cloud.opencpu.org/ocpu") +get_val <- function(temp_key, api_domain = "https://opencpu.lifewatch.be") { + # request data and open connection + response_connection <- httr::RETRY( + verb = "GET", + url = glue::glue( + "{api_domain}", + "tmp/{temp_key}/R/.val/rds", + .sep = "/" + ), + times = 5 + ) %>% + httr::content(as = "raw") %>% + rawConnection() + # read connection + api_response <- response_connection %>% + gzcon() %>% + readRDS() + # close connection + close(response_connection) + # Return OpenCPU return object + return(api_response) +} + +#' Return the arguments as a named list of the parent environment +#' +#' Because the requests to the API are so similar, it's more DRY to pass the +#' function arguments of the parent function directly to the API, instead of +#' repeating them in the function body. +#' +#' @return a named list of name value pairs form the parent environement +#' +#' @family helper functions +#' @noRd +return_parent_arguments <- function(depth = 1) { + # lock in the environment of the function we are being called in. Otherwise + # lazy evaluation can cause trouble + parent_env <- rlang::caller_env(n = depth) + env_names <- rlang::env_names(parent_env) + # set the environement names so lapply can output a names list + names(env_names) <- env_names + lapply( + env_names, + function(x) rlang::env_get(env = parent_env, nm = x) + ) +} + +#' Check an OpenCPU reponse object and forward any errors +#' +#' @param response httr::response object from an OpenCPU API call +#' +#' @family helper functions +#' @noRd +check_opencpu_response <- function(response) { + # Stop if etnservice forwarded an error + assertthat::assert_that(response$status_code != 400, + msg = httr::content(response, + as = "text", + encoding = "UTF-8" + ) + ) + + # Stop for other HTTP errors + assertthat::assert_that(!httr::http_error(response), + msg = glue::glue( + "API request failed: {http_message}", + http_message = httr::http_status(response)$message + ) + ) +} + + +#' Lifecycle warning for the deprecated connection argument +#' +#' @param function_identity Character of length one with the name +#' of the function the warning is being generated from +#' +#' @family helper functions +#' @noRd +deprecate_warn_connection <- function() { + lifecycle::deprecate_warn( + when = "v3.0.0", + what = glue::glue("{function_identity}(connection)", + function_identity = get_parent_fn_name(depth = 2) + ), + details = glue::glue( + "Please set `api = FALSE` to use local database, ", + "otherwise the API will be used" + ), + env = rlang::caller_env(), + user_env = rlang::caller_env(2), + always = TRUE + ) +} + +#' Get the name (symbol) of the parent function +#' +#' @return A length one Character with the name of the parent function. +#' +#' @family helper functions +#' @noRd +#' +#' @examples +#' child_fn <- function() { +#' get_parent_fn_name() +#' } +#' +#' parent_fn <- function() { +#' print(get_parent_fn_name()) +#' print(paste("nested:", child_fn())) +#' } +#' +#' parent_fn() +get_parent_fn_name <- function(depth = 1) { + rlang::call_name(rlang::frame_call(frame = rlang::caller_env(n = depth))) +} + +#' Forward function arguments to API and retreive response +#' +#' @param function_identity Character vector of what function should be passed +#' @param payload Arguments to be passed to OpenCPU function +#' +#' @return The same return object of the `function_identity` function +#' +#' @family helper functions +#' @noRd +forward_to_api <- function( + function_identity, + payload, + domain = "https://opencpu.lifewatch.be/library/etnservice/R") { + # Get credentials and attatch to payload + payload <- append(payload, list(credentials = get_credentials()), after = 0) + # Set endpoint based on the passed function_identity + # NOTE trailing backslash is important for OpenCPU + endpoint <- glue::glue("{domain}/{function_identity}/") + + # Forward the function and arguments to the API: call 1 + ## Retry if server responds with HTTP error, use default rate settings of httr + response <- + httr::RETRY( + verb = "POST", + url = endpoint, + body = payload, + encode = "json", + terminate_on = c(400), + times = 5 + ) + + # Check if the response contains any errors, and forward them if so. + check_opencpu_response(response) + + # Fetch the output from the API: call 2 + get_val(extract_temp_key(response)) +} + + +#' Conductor Helper: point the way to API or SQL helper +#' +#' Helper that conducts it's parent function to either use a helper to query the api, +#' or a helper to query a local database connection using SQL. +#' +#' @param api Logical, Should the API be used? +#' +#' @return parsed R object as resulting from the API +#' +#' @family helper functions +#' @noRd +conduct_parent_to_helpers <- function(api) { + # Check arguments + assertthat::assert_that(assertthat::is.flag(api)) + + # Lock in the name of the parent function + function_identity <- + get_parent_fn_name(depth = 2) + + # Get the argument values from the parent function + arguments_to_pass <- + return_parent_arguments(depth = 2)[ + !names(return_parent_arguments(depth = 2)) %in% c( + "api", + "connection", + "function_identity" + ) + ] + + if (api) { + out <- do.call( + forward_to_api, + list(function_identity = function_identity, payload = arguments_to_pass) + ) + } else { + out <- do.call(glue::glue("{function_identity}_sql"), arguments_to_pass) + } + + return(out) +} diff --git a/R/write_dwc.R b/R/write_dwc.R index 17882d08..5e5603e4 100644 --- a/R/write_dwc.R +++ b/R/write_dwc.R @@ -73,7 +73,8 @@ write_dwc <- function(connection = con, ) # Get imis dataset id and title - project <- get_animal_projects(connection, animal_project_code) + project <- + get_animal_projects(api = FALSE, animal_project_code = animal_project_code) imis_dataset_id <- project$imis_dataset_id imis_url <- "https://www.vliz.be/en/imis?module=dataset&dasid=" imis_json <- jsonlite::read_json(paste0(imis_url, imis_dataset_id, "&show=json")) @@ -87,6 +88,9 @@ write_dwc <- function(connection = con, .con = connection ) dwc_occurrence <- DBI::dbGetQuery(connection, dwc_occurrence_sql) + + # Close connection + DBI::dbDisconnect(connection) # Return object or write files if (is.null(directory)) { diff --git a/man/connect_to_etn.Rd b/man/connect_to_etn.Rd index 2d0d13be..18c70013 100644 --- a/man/connect_to_etn.Rd +++ b/man/connect_to_etn.Rd @@ -15,6 +15,7 @@ connect_to_etn(username = Sys.getenv("userid"), password = Sys.getenv("pwd")) ODBC connection to ETN database. } \description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Connect to the ETN database using username and password. } \examples{ diff --git a/man/download_acoustic_dataset.Rd b/man/download_acoustic_dataset.Rd index a0d43413..1e617c0f 100644 --- a/man/download_acoustic_dataset.Rd +++ b/man/download_acoustic_dataset.Rd @@ -5,15 +5,14 @@ \title{Download acoustic data package} \usage{ download_acoustic_dataset( - connection = con, animal_project_code, scientific_name = NULL, - directory = animal_project_code + directory = animal_project_code, + api = TRUE, + connection ) } \arguments{ -\item{connection}{A connection to the ETN database. Defaults to \code{con}.} - \item{animal_project_code}{Character. Animal project you want to download data for. Required.} @@ -23,6 +22,8 @@ Defaults to no all (all scientific names, include "Sync tag", etc.).} \item{directory}{Character. Relative path to local download directory. Defaults to creating a directory named after animal project code. Existing files of the same name will be overwritten.} + +\item{connection}{A connection to the ETN database. Defaults to \code{con}.} } \description{ Download all acoustic data related to an \strong{animal project} as a data diff --git a/man/etn-deprecated.Rd b/man/etn-deprecated.Rd deleted file mode 100644 index c91e027c..00000000 --- a/man/etn-deprecated.Rd +++ /dev/null @@ -1,34 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/etn-deprecated.R -\name{etn-deprecated} -\alias{etn-deprecated} -\alias{get_deployments} -\alias{get_detections} -\alias{get_projects} -\alias{get_receivers} -\alias{list_network_project_codes} -\alias{list_tag_ids} -\title{Deprecated functions in etn} -\usage{ -get_deployments(connection = con, network_project_code = NULL, ...) - -get_detections( - connection = con, - tag_id = NULL, - network_project_code = NULL, - ... -) - -get_projects(connection = con, project_type, application_type) - -get_receivers(...) - -list_network_project_codes(...) - -list_tag_ids(...) -} -\description{ -The functions listed below are deprecated or renamed and will be defunct in -the near future. -} -\keyword{internal} diff --git a/man/figures/lifecycle-archived.svg b/man/figures/lifecycle-archived.svg new file mode 100644 index 00000000..48f72a6f --- /dev/null +++ b/man/figures/lifecycle-archived.svg @@ -0,0 +1 @@ + lifecyclelifecyclearchivedarchived \ No newline at end of file diff --git a/man/figures/lifecycle-defunct.svg b/man/figures/lifecycle-defunct.svg new file mode 100644 index 00000000..01452e5f --- /dev/null +++ b/man/figures/lifecycle-defunct.svg @@ -0,0 +1 @@ +lifecyclelifecycledefunctdefunct \ No newline at end of file diff --git a/man/figures/lifecycle-deprecated.svg b/man/figures/lifecycle-deprecated.svg new file mode 100644 index 00000000..4baaee01 --- /dev/null +++ b/man/figures/lifecycle-deprecated.svg @@ -0,0 +1 @@ +lifecyclelifecycledeprecateddeprecated \ No newline at end of file diff --git a/man/figures/lifecycle-experimental.svg b/man/figures/lifecycle-experimental.svg new file mode 100644 index 00000000..d1d060e9 --- /dev/null +++ b/man/figures/lifecycle-experimental.svg @@ -0,0 +1 @@ +lifecyclelifecycleexperimentalexperimental \ No newline at end of file diff --git a/man/figures/lifecycle-maturing.svg b/man/figures/lifecycle-maturing.svg new file mode 100644 index 00000000..df713101 --- /dev/null +++ b/man/figures/lifecycle-maturing.svg @@ -0,0 +1 @@ +lifecyclelifecyclematuringmaturing \ No newline at end of file diff --git a/man/figures/lifecycle-questioning.svg b/man/figures/lifecycle-questioning.svg new file mode 100644 index 00000000..08ee0c90 --- /dev/null +++ b/man/figures/lifecycle-questioning.svg @@ -0,0 +1 @@ +lifecyclelifecyclequestioningquestioning \ No newline at end of file diff --git a/man/figures/lifecycle-stable.svg b/man/figures/lifecycle-stable.svg new file mode 100644 index 00000000..e015dc81 --- /dev/null +++ b/man/figures/lifecycle-stable.svg @@ -0,0 +1 @@ +lifecyclelifecyclestablestable \ No newline at end of file diff --git a/man/figures/lifecycle-superseded.svg b/man/figures/lifecycle-superseded.svg new file mode 100644 index 00000000..75f24f55 --- /dev/null +++ b/man/figures/lifecycle-superseded.svg @@ -0,0 +1 @@ + lifecyclelifecyclesupersededsuperseded \ No newline at end of file diff --git a/man/get_acoustic_deployments.Rd b/man/get_acoustic_deployments.Rd index 250f0cba..3b0e02a3 100644 --- a/man/get_acoustic_deployments.Rd +++ b/man/get_acoustic_deployments.Rd @@ -5,17 +5,16 @@ \title{Get acoustic deployment data} \usage{ get_acoustic_deployments( - connection = con, deployment_id = NULL, receiver_id = NULL, acoustic_project_code = NULL, station_name = NULL, - open_only = FALSE + open_only = FALSE, + api = TRUE, + connection ) } \arguments{ -\item{connection}{A connection to the ETN database. Defaults to \code{con}.} - \item{deployment_id}{Integer (vector). One or more deployment identifiers.} \item{receiver_id}{Character (vector). One or more receiver identifiers.} @@ -28,6 +27,8 @@ names.} \item{open_only}{Logical. Restrict deployments to those that are currently open (i.e. no end date defined). Defaults to \code{FALSE}.} + +\item{connection}{A connection to the ETN database. Defaults to \code{con}.} } \value{ A tibble with acoustic deployment data, sorted by diff --git a/man/get_acoustic_detections.Rd b/man/get_acoustic_detections.Rd index ad51b75e..47a1d03b 100644 --- a/man/get_acoustic_detections.Rd +++ b/man/get_acoustic_detections.Rd @@ -5,7 +5,6 @@ \title{Get acoustic detections data} \usage{ get_acoustic_detections( - connection = con, start_date = NULL, end_date = NULL, acoustic_tag_id = NULL, @@ -14,12 +13,12 @@ get_acoustic_detections( acoustic_project_code = NULL, receiver_id = NULL, station_name = NULL, - limit = FALSE + limit = FALSE, + api = TRUE, + connection ) } \arguments{ -\item{connection}{A connection to the ETN database. Defaults to \code{con}.} - \item{start_date}{Character. Start date (inclusive) in ISO 8601 format ( \code{yyyy-mm-dd}, \code{yyyy-mm} or \code{yyyy}).} @@ -43,6 +42,8 @@ names.} \item{limit}{Logical. Limit the number of returned records to 100 (useful for testing purposes). Defaults to \code{FALSE}.} + +\item{connection}{A connection to the ETN database. Defaults to \code{con}.} } \value{ A tibble with acoustic detections data, sorted by \code{acoustic_tag_id} diff --git a/man/get_acoustic_projects.Rd b/man/get_acoustic_projects.Rd index fb8d6e35..9c43e9c3 100644 --- a/man/get_acoustic_projects.Rd +++ b/man/get_acoustic_projects.Rd @@ -4,13 +4,13 @@ \alias{get_acoustic_projects} \title{Get acoustic project data} \usage{ -get_acoustic_projects(connection = con, acoustic_project_code = NULL) +get_acoustic_projects(acoustic_project_code = NULL, api = TRUE, connection) } \arguments{ -\item{connection}{A connection to the ETN database. Defaults to \code{con}.} - \item{acoustic_project_code}{Character (vector). One or more acoustic project codes. Case-insensitive.} + +\item{connection}{A connection to the ETN database. Defaults to \code{con}.} } \value{ A tibble with acoustic project data, sorted by \code{project_code}. See diff --git a/man/get_acoustic_receivers.Rd b/man/get_acoustic_receivers.Rd index 32d3ad2e..af7774b3 100644 --- a/man/get_acoustic_receivers.Rd +++ b/man/get_acoustic_receivers.Rd @@ -4,14 +4,19 @@ \alias{get_acoustic_receivers} \title{Get acoustic receiver data} \usage{ -get_acoustic_receivers(connection = con, receiver_id = NULL, status = NULL) +get_acoustic_receivers( + receiver_id = NULL, + status = NULL, + api = TRUE, + connection +) } \arguments{ -\item{connection}{A connection to the ETN database. Defaults to \code{con}.} - \item{receiver_id}{Character (vector). One or more receiver identifiers.} \item{status}{Character. One or more statuses, e.g. \code{available} or \code{broken}.} + +\item{connection}{A connection to the ETN database. Defaults to \code{con}.} } \value{ A tibble with acoustic receiver data, sorted by \code{receiver_id}. See diff --git a/man/get_animal_projects.Rd b/man/get_animal_projects.Rd index d68d6115..f160246d 100644 --- a/man/get_animal_projects.Rd +++ b/man/get_animal_projects.Rd @@ -4,13 +4,13 @@ \alias{get_animal_projects} \title{Get animal project data} \usage{ -get_animal_projects(connection = con, animal_project_code = NULL) +get_animal_projects(animal_project_code = NULL, api = TRUE, connection) } \arguments{ -\item{connection}{A connection to the ETN database. Defaults to \code{con}.} - \item{animal_project_code}{Character (vector). One or more animal project codes. Case-insensitive.} + +\item{connection}{A connection to the ETN database. Defaults to \code{con}.} } \value{ A tibble with animal project data, sorted by \code{project_code}. See diff --git a/man/get_animals.Rd b/man/get_animals.Rd index 32d41d46..d1438d8d 100644 --- a/man/get_animals.Rd +++ b/man/get_animals.Rd @@ -5,16 +5,15 @@ \title{Get animal data} \usage{ get_animals( - connection = con, animal_id = NULL, tag_serial_number = NULL, animal_project_code = NULL, - scientific_name = NULL + scientific_name = NULL, + api = TRUE, + connection ) } \arguments{ -\item{connection}{A connection to the ETN database. Defaults to \code{con}.} - \item{animal_id}{Integer (vector). One or more animal identifiers.} \item{tag_serial_number}{Character (vector). One or more tag serial numbers.} @@ -23,6 +22,8 @@ get_animals( codes. Case-insensitive.} \item{scientific_name}{Character (vector). One or more scientific names.} + +\item{connection}{A connection to the ETN database. Defaults to \code{con}.} } \value{ A tibble with animals data, sorted by \code{animal_project_code}, diff --git a/man/get_cpod_projects.Rd b/man/get_cpod_projects.Rd index 86b89f40..06bd8a1e 100644 --- a/man/get_cpod_projects.Rd +++ b/man/get_cpod_projects.Rd @@ -4,13 +4,13 @@ \alias{get_cpod_projects} \title{Get cpod project data} \usage{ -get_cpod_projects(connection = con, cpod_project_code = NULL) +get_cpod_projects(cpod_project_code = NULL, api = TRUE, connection) } \arguments{ -\item{connection}{A connection to the ETN database. Defaults to \code{con}.} - \item{cpod_project_code}{Character (vector). One or more cpod project codes. Case-insensitive.} + +\item{connection}{A connection to the ETN database. Defaults to \code{con}.} } \value{ A tibble with animal project data, sorted by \code{project_code}. See diff --git a/man/get_tags.Rd b/man/get_tags.Rd index 1f456706..53acd286 100644 --- a/man/get_tags.Rd +++ b/man/get_tags.Rd @@ -5,16 +5,15 @@ \title{Get tag data} \usage{ get_tags( - connection = con, tag_type = NULL, tag_subtype = NULL, tag_serial_number = NULL, - acoustic_tag_id = NULL + acoustic_tag_id = NULL, + api = TRUE, + connection ) } \arguments{ -\item{connection}{A connection to the ETN database. Defaults to \code{con}.} - \item{tag_type}{Character (vector). \code{acoustic} or \code{archival}. Some tags are both, find those with \code{acoustic-archival}.} @@ -25,6 +24,8 @@ both, find those with \code{acoustic-archival}.} \item{acoustic_tag_id}{Character (vector). One or more acoustic tag identifiers, i.e. identifiers found in \code{\link[=get_acoustic_detections]{get_acoustic_detections()}}.} + +\item{connection}{A connection to the ETN database. Defaults to \code{con}.} } \value{ A tibble with tags data, sorted by \code{tag_serial_number}. See also diff --git a/man/list_acoustic_project_codes.Rd b/man/list_acoustic_project_codes.Rd index d26aa52b..afe6266f 100644 --- a/man/list_acoustic_project_codes.Rd +++ b/man/list_acoustic_project_codes.Rd @@ -4,7 +4,7 @@ \alias{list_acoustic_project_codes} \title{List all available acoustic project codes} \usage{ -list_acoustic_project_codes(connection = con) +list_acoustic_project_codes(api = TRUE, connection) } \arguments{ \item{connection}{A connection to the ETN database. Defaults to \code{con}.} diff --git a/man/list_acoustic_tag_ids.Rd b/man/list_acoustic_tag_ids.Rd index c1280642..755fa71f 100644 --- a/man/list_acoustic_tag_ids.Rd +++ b/man/list_acoustic_tag_ids.Rd @@ -4,7 +4,7 @@ \alias{list_acoustic_tag_ids} \title{List all available acoustic tag ids} \usage{ -list_acoustic_tag_ids(connection = con) +list_acoustic_tag_ids(api = TRUE, connection) } \arguments{ \item{connection}{A connection to the ETN database. Defaults to \code{con}.} diff --git a/man/list_animal_ids.Rd b/man/list_animal_ids.Rd index ed035426..517edf39 100644 --- a/man/list_animal_ids.Rd +++ b/man/list_animal_ids.Rd @@ -4,10 +4,7 @@ \alias{list_animal_ids} \title{List all available animal ids} \usage{ -list_animal_ids(connection = con) -} -\arguments{ -\item{connection}{A connection to the ETN database. Defaults to \code{con}.} +list_animal_ids(api = TRUE, connection) } \value{ A vector of all unique \code{id_pk} present in \code{common.animal_release}. diff --git a/man/list_animal_project_codes.Rd b/man/list_animal_project_codes.Rd index 6f177893..168551ee 100644 --- a/man/list_animal_project_codes.Rd +++ b/man/list_animal_project_codes.Rd @@ -4,7 +4,7 @@ \alias{list_animal_project_codes} \title{List all available animal project codes} \usage{ -list_animal_project_codes(connection = con) +list_animal_project_codes(api = TRUE, connection) } \arguments{ \item{connection}{A connection to the ETN database. Defaults to \code{con}.} diff --git a/man/list_cpod_project_codes.Rd b/man/list_cpod_project_codes.Rd index f2bd9e0c..dee90aac 100644 --- a/man/list_cpod_project_codes.Rd +++ b/man/list_cpod_project_codes.Rd @@ -4,7 +4,7 @@ \alias{list_cpod_project_codes} \title{List all available cpod project codes} \usage{ -list_cpod_project_codes(connection = con) +list_cpod_project_codes(api = TRUE, connection) } \arguments{ \item{connection}{A connection to the ETN database. Defaults to \code{con}.} diff --git a/man/list_deployment_ids.Rd b/man/list_deployment_ids.Rd index 52bd6b27..d68af430 100644 --- a/man/list_deployment_ids.Rd +++ b/man/list_deployment_ids.Rd @@ -4,7 +4,7 @@ \alias{list_deployment_ids} \title{List all available receiver ids} \usage{ -list_deployment_ids(connection = con) +list_deployment_ids(api = TRUE, connection) } \arguments{ \item{connection}{A connection to the ETN database. Defaults to \code{con}.} diff --git a/man/list_receiver_ids.Rd b/man/list_receiver_ids.Rd index baa9aa42..c329a500 100644 --- a/man/list_receiver_ids.Rd +++ b/man/list_receiver_ids.Rd @@ -4,7 +4,7 @@ \alias{list_receiver_ids} \title{List all available receiver ids} \usage{ -list_receiver_ids(connection = con) +list_receiver_ids(api = TRUE, connection) } \arguments{ \item{connection}{A connection to the ETN database. Defaults to \code{con}.} diff --git a/man/list_scientific_names.Rd b/man/list_scientific_names.Rd index 34b33cd9..39b77eb3 100644 --- a/man/list_scientific_names.Rd +++ b/man/list_scientific_names.Rd @@ -4,10 +4,7 @@ \alias{list_scientific_names} \title{List all available scientific names} \usage{ -list_scientific_names(connection = con) -} -\arguments{ -\item{connection}{A connection to the ETN database. Defaults to \code{con}.} +list_scientific_names(api = TRUE, connection) } \value{ A vector of all unique \code{scientific_name} present in diff --git a/man/list_station_names.Rd b/man/list_station_names.Rd index 7ff2b8f4..171cfcb3 100644 --- a/man/list_station_names.Rd +++ b/man/list_station_names.Rd @@ -4,7 +4,7 @@ \alias{list_station_names} \title{List all available station names} \usage{ -list_station_names(connection = con) +list_station_names(api = TRUE, connection) } \arguments{ \item{connection}{A connection to the ETN database. Defaults to \code{con}.} diff --git a/man/list_tag_serial_numbers.Rd b/man/list_tag_serial_numbers.Rd index 066150bd..d59b5657 100644 --- a/man/list_tag_serial_numbers.Rd +++ b/man/list_tag_serial_numbers.Rd @@ -4,7 +4,7 @@ \alias{list_tag_serial_numbers} \title{List all available tag serial numbers} \usage{ -list_tag_serial_numbers(connection = con) +list_tag_serial_numbers(api = TRUE, connection) } \arguments{ \item{connection}{A connection to the ETN database. Defaults to \code{con}.} diff --git a/tests/testthat.R b/tests/testthat.R index 8391ec77..f80c30b3 100644 --- a/tests/testthat.R +++ b/tests/testthat.R @@ -1,3 +1,11 @@ +# This file is part of the standard setup for testthat. +# It is recommended that you do not modify it. +# +# Where should you do additional test configuration? +# Learn more about the roles of various files in: +# * https://r-pkgs.org/tests.html +# * https://testthat.r-lib.org/reference/test_package.html#special-files + library(testthat) library(dplyr) library(etn) diff --git a/tests/testthat/_snaps/api/download_acoustic_dataset.md b/tests/testthat/_snaps/api/download_acoustic_dataset.md new file mode 100644 index 00000000..3c60fcad --- /dev/null +++ b/tests/testthat/_snaps/api/download_acoustic_dataset.md @@ -0,0 +1,26 @@ +# download_acoustic_dataset() creates the expected messages and files using api + + Code + download_acoustic_dataset(api = TRUE, animal_project_code = "2014_demer", + directory = download_dir) + Message + Downloading data to directory : + * (1/6): downloading animals.csv + * (2/6): downloading tags.csv + * (3/6): downloading detections.csv + * (4/6): downloading deployments.csv + * (5/6): downloading receivers.csv + * (6/6): adding datapackage.json as file metadata + + Summary statistics for dataset `2014_demer`: + * number of animals: 16 + * number of tags: 16 + * number of detections: 236918 + * number of deployments: 1081 + * number of receivers: 244 + * first date of detection: 2014-04-18 + * last date of detection: 2018-09-15 + * included scientific names: Petromyzon marinus, Rutilus rutilus, Silurus glanis, Squalius cephalus + * included acoustic projects: V2LCHASES, albert, demer, dijle, zeeschelde + + diff --git a/tests/testthat/_snaps/list_animal_ids.md b/tests/testthat/_snaps/list_animal_ids.md new file mode 100644 index 00000000..e6f8fb38 --- /dev/null +++ b/tests/testthat/_snaps/list_animal_ids.md @@ -0,0 +1,10 @@ +# list_animal_ids() warns for depreciation of connection + + Code + animal_ids <- list_animal_ids(connection = "any_object") + Warning + The `connection` argument of `list_animal_ids()` is deprecated as of etn v3.0.0. + i Please set `api = FALSE` to use local database, otherwise the API will be used + i The deprecated feature was likely used in the etn package. + Please report the issue at . + diff --git a/tests/testthat/_snaps/sql/download_acoustic_dataset.md b/tests/testthat/_snaps/sql/download_acoustic_dataset.md new file mode 100644 index 00000000..7142f2e9 --- /dev/null +++ b/tests/testthat/_snaps/sql/download_acoustic_dataset.md @@ -0,0 +1,26 @@ +# download_acoustic_dataset() creates the expected messages and files using local db + + Code + download_acoustic_dataset(api = FALSE, animal_project_code = "2014_demer", + directory = download_dir) + Message + Downloading data to directory : + * (1/6): downloading animals.csv + * (2/6): downloading tags.csv + * (3/6): downloading detections.csv + * (4/6): downloading deployments.csv + * (5/6): downloading receivers.csv + * (6/6): adding datapackage.json as file metadata + + Summary statistics for dataset `2014_demer`: + * number of animals: 16 + * number of tags: 16 + * number of detections: 236918 + * number of deployments: 1081 + * number of receivers: 244 + * first date of detection: 2014-04-18 + * last date of detection: 2018-09-15 + * included scientific names: Petromyzon marinus, Rutilus rutilus, Silurus glanis, Squalius cephalus + * included acoustic projects: V2LCHASES, albert, demer, dijle, zeeschelde + + diff --git a/tests/testthat/test-api_helpers.R b/tests/testthat/test-api_helpers.R new file mode 100644 index 00000000..3359f604 --- /dev/null +++ b/tests/testthat/test-api_helpers.R @@ -0,0 +1,133 @@ + +# conduct_parent_to_helpers() --------------------------------------------- + + +test_that("conduct_parent_to_helpers() can stop on bad input parameters", { + expect_error( + conduct_parent_to_helpers(api = "not a flag!") + ) +}) + +# extract_temp_key() ------------------------------------------------------ + + +test_that("extract_temp_key() can extract a key from a httr::response object", { + response <- + httr::POST("https://cloud.opencpu.org/ocpu/library/stats/R/rnorm", + body = list(n = 2) + ) + temp_key <- extract_temp_key(response) + expect_type(temp_key, "character") + expect_length(temp_key, 1) + expect_true(nchar(temp_key) == 15) +}) + +# get_val() --------------------------------------------------------------- + + +test_that("get_val() can get a value from a temp_key", { + # NOTE Dependent on the OpenCPU testing API + response <- + httr::POST("https://cloud.opencpu.org/ocpu/library/stats/R/rnorm", + body = list(n = 2) + ) + temp_key <- extract_temp_key(response) + domain <- "https://cloud.opencpu.org/ocpu" + + expect_no_error(api_out <- get_val(temp_key, domain)) + expect_type(api_out, "double") + expect_length(api_out, 2) +}) + +# return_parent_arguments() ----------------------------------------------- + + +test_that("return_parent_arguments() can return parent function arguments", { + # Create some nested functions to test in + parent_fn <- function(p_arg_1 = "a", p_arg_2 = 4) { + return_parent_arguments() + } + grandparent_fn <- function(gp_arg_1 = pi, gp_arg_2 = c("B", 42)) { + parent_fn() + } + + # By default return_parent_arguments() should always return the arguments of + # the function it was called in. + expect_identical( + parent_fn(), + list(p_arg_1 = "a", p_arg_2 = 4) + ) + expect_identical( + grandparent_fn(), + list(p_arg_1 = "a", p_arg_2 = 4) + ) +}) + +test_that("return_parent_arguments() can return higher call function arguments", { + # Create some nested functions to test in + parent_fn <- function(p_arg_1 = "a", p_arg_2 = 4) { + return_parent_arguments(depth = 2) + } + grandparent_fn <- function(gp_arg_1 = pi, gp_arg_2 = c("B", 42)) { + parent_fn() + } + + # By setting depth return_parent_arguments() can also return arguments of + # higher level calls + expect_identical( + grandparent_fn(), + list(gp_arg_1 = pi, gp_arg_2 = c("B", "42")) + ) +}) + +test_that("check_opencpu_response() returns error on HTTP error codes", { + expect_error( + check_opencpu_response( + httr::RETRY(verb = "GET", + "http://httpbin.org/status/404", + terminate_on = 404)), + regexp = "API request failed: Client error: (404) Not Found", + fixed = TRUE + ) + expect_error( + check_opencpu_response( + httr::RETRY(verb = "GET", + "http://httpbin.org/status/504", + terminate_on = 504)), + regexp = "API request failed: Server error: (504) Gateway Timeout", + fixed = TRUE + ) + expect_error( + check_opencpu_response( + httr::RETRY(verb = "GET", + "http://httpbin.org/status/429", + terminate_on = 429)), + regexp = "API request failed: Client error: (429) Too Many Requests (RFC 6585)", + fixed = TRUE + ) +}) + +test_that("deprecate_warn_connection() returns warning with function symbol", { + fn_to_test <- function(connection) {deprecate_warn_connection()} + expect_warning( + fn_to_test(), + regexp = "The `connection` argument of `fn_to_test\\(\\)` is deprecated as of" + ) +}) + +test_that("get_parent_fn_name() can return the name of the parent function", { + parent_function_with_a_cool_name <- function(){get_parent_fn_name()} + expect_identical( + parent_function_with_a_cool_name(), + "parent_function_with_a_cool_name" + ) +}) + +test_that("get_parent_fn_name() can return the name a higher level caller", { + parent_function_with_a_cool_name <- function(){get_parent_fn_name(depth = 2)} + grandparent_function <- function(){parent_function_with_a_cool_name()} + expect_identical( + grandparent_function(), + "grandparent_function" + ) +}) diff --git a/tests/testthat/test-download_acoustic_dataset-message.txt b/tests/testthat/test-download_acoustic_dataset-message.txt deleted file mode 100644 index ab81b7c0..00000000 --- a/tests/testthat/test-download_acoustic_dataset-message.txt +++ /dev/null @@ -1,19 +0,0 @@ -Downloading data to directory `./temp_download`: -* (1/6): downloading animals.csv -* (2/6): downloading tags.csv -* (3/6): downloading detections.csv -* (4/6): downloading deployments.csv -* (5/6): downloading receivers.csv -* (6/6): adding datapackage.json as file metadata - -Summary statistics for dataset `2014_demer`: -* number of animals: 16 -* number of tags: 16 -* number of detections: 236918 -* number of deployments: 1062 -* number of receivers: 243 -* first date of detection: 2014-04-18 -* last date of detection: 2018-09-15 -* included scientific names: Petromyzon marinus, Rutilus rutilus, Silurus glanis, Squalius cephalus -* included acoustic projects: albert, demer, dijle, V2LCHASES, zeeschelde - diff --git a/tests/testthat/test-download_acoustic_dataset.R b/tests/testthat/test-download_acoustic_dataset.R index 6be9389a..569a018e 100644 --- a/tests/testthat/test-download_acoustic_dataset.R +++ b/tests/testthat/test-download_acoustic_dataset.R @@ -1,8 +1,7 @@ -con <- connect_to_etn() - -test_that("download_acoustic_dataset() creates the expected messages and files", { - download_dir <- "./temp_download" +test_that("download_acoustic_dataset() creates the expected messages and files using api", { + download_dir <- file.path(tempdir(), "using_api") dir.create(download_dir, recursive = TRUE, showWarnings = FALSE) + files_to_create <- c( "animals.csv", "tags.csv", @@ -11,30 +10,49 @@ test_that("download_acoustic_dataset() creates the expected messages and files", "receivers.csv", "datapackage.json" ) - message <- readLines("./test-download_acoustic_dataset-message.txt") - # Process output message - message <- paste0(message, "\n") - # Run function - evaluate_download <- evaluate_promise({ + expect_snapshot( download_acoustic_dataset( - con, + api = TRUE, animal_project_code = "2014_demer", directory = download_dir - ) - }) + ), + transform = ~ stringr::str_remove(.x, pattern = "(?=`\\/).+(?<=`)"), + variant = "api" + ) # Function creates the expected files - expect_true(all(sort(list.files(download_dir)) == sort(files_to_create))) + expect_true(all(files_to_create %in% list.files(download_dir))) - # Function returns the expected output message - expect_true(all(evaluate_download$messages == message)) + # Remove generated files and directories after test + unlink(download_dir, recursive = TRUE) +}) + +test_that("download_acoustic_dataset() creates the expected messages and files using local db", { + download_dir <- file.path(tempdir(), "using_sql") + dir.create(download_dir, recursive = TRUE, showWarnings = FALSE) + + files_to_create <- c( + "animals.csv", + "tags.csv", + "detections.csv", + "deployments.csv", + "receivers.csv", + "datapackage.json" + ) - # Function returns no warnings (character of length 0) - expect_true(length(evaluate_download$warnings) == 0) + expect_snapshot( + download_acoustic_dataset( + api = FALSE, + animal_project_code = "2014_demer", + directory = download_dir + ), + transform = ~ stringr::str_remove(.x, pattern = "(?=`\\/).+(?<=`)"), + variant = "sql" + ) - # Function returns no result - expect_null(evaluate_download$result) + # Function creates the expected files + expect_true(all(files_to_create %in% list.files(download_dir))) # Remove generated files and directories after test unlink(download_dir, recursive = TRUE) diff --git a/tests/testthat/test-etn-deprecated.R b/tests/testthat/test-etn-deprecated.R deleted file mode 100644 index 3dbc7c87..00000000 --- a/tests/testthat/test-etn-deprecated.R +++ /dev/null @@ -1,64 +0,0 @@ -con <- connect_to_etn() - -test_that("get_deployments() redirects to correct function", { - expect_warning(get_deployments(con), "is deprecated") - suppressWarnings(expect_equal( - get_deployments(con, network_project_code = "demer"), - get_acoustic_deployments(con, acoustic_project_code = "demer") - )) -}) - -test_that("get_detections() redirects to correct function", { - expect_warning(get_detections(con, limit = TRUE), "is deprecated") - suppressWarnings(expect_equal( - get_detections( - con, - tag_id = "A69-1601-16130", - network_project_code = "demer", - limit = TRUE - ), - get_acoustic_detections( - con, - acoustic_tag_id = "A69-1601-16130", - acoustic_project_code = "demer", - limit = TRUE - ) - )) -}) - -test_that("get_projects() redirects to correct function", { - expect_warning(get_projects(con), "is deprecated") - suppressWarnings(expect_equal( - get_projects(con), get_animal_projects(con) - )) - suppressWarnings(expect_equal( - get_projects(con, project_type = "animal"), get_animal_projects(con) - )) - suppressWarnings(expect_equal( - get_projects(con, project_type = "network"), get_acoustic_projects(con) - )) - suppressWarnings(expect_equal( - get_projects(con, application_type = "cpod"), get_cpod_projects(con) - )) -}) - -test_that("get_receivers() redirects to correct function", { - expect_warning(get_receivers(con), "is deprecated") - suppressWarnings(expect_equal( - get_receivers(con), get_acoustic_receivers(con) - )) -}) - -test_that("list_network_project_codes() redirects to correct function", { - expect_warning(list_network_project_codes(con), "is deprecated") - suppressWarnings(expect_equal( - list_network_project_codes(con), list_acoustic_project_codes(con) - )) -}) - -test_that("list_tag_ids() redirects to correct function", { - expect_warning(list_tag_ids(con), "is deprecated") - suppressWarnings(expect_equal( - list_tag_ids(con), list_acoustic_tag_ids(con) - )) -}) diff --git a/tests/testthat/test-get_acoustic_deployments.R b/tests/testthat/test-get_acoustic_deployments.R index 9d531541..041eaa5d 100644 --- a/tests/testthat/test-get_acoustic_deployments.R +++ b/tests/testthat/test-get_acoustic_deployments.R @@ -1,25 +1,28 @@ -con <- connect_to_etn() +# con <- connect_to_etn() -test_that("get_acoustic_deployments() returns error for incorrect connection", { - expect_error( - get_acoustic_deployments(con = "not_a_connection"), - "Not a connection object to database." - ) -}) +# test_that("get_acoustic_deployments() returns error for incorrect connection", { +# expect_error( +# get_acoustic_deployments(con = "not_a_connection"), +# "Not a connection object to database." +# ) +# }) test_that("get_acoustic_deployments() returns a tibble", { - df <- get_acoustic_deployments(con) + df <- get_acoustic_deployments() expect_s3_class(df, "data.frame") expect_s3_class(df, "tbl") + df_sql <- get_acoustic_deployments(api = FALSE) + expect_s3_class(df_sql, "data.frame") + expect_s3_class(df_sql, "tbl") }) test_that("get_acoustic_deployments() returns unique deployment_id", { - df <- get_acoustic_deployments(con) + df <- get_acoustic_deployments() expect_equal(nrow(df), nrow(df %>% distinct(deployment_id))) }) test_that("get_acoustic_deployments() returns the expected columns", { - df <- get_acoustic_deployments(con) + df <- get_acoustic_deployments() expected_col_names <- c( "deployment_id", "receiver_id", @@ -65,12 +68,18 @@ test_that("get_acoustic_deployments() returns the expected columns", { test_that("get_acoustic_deployments() allows selecting on deployment_id", { # Errors - expect_error(get_acoustic_deployments(con, deployment_id = "not_a_deployment_id")) - expect_error(get_acoustic_deployments(con, deployment_id = c("1437", "not_a_deployment_id"))) + expect_error( + get_acoustic_deployments(deployment_id = "not_a_deployment_id"), + regexp = "Can't find receiver_id `not_a_deployment_id` in" + ) + expect_error( + get_acoustic_deployments(deployment_id = c("1437", "not_a_deployment_id")), + regexp = "Can't find receiver_id `1437` and/or `not_a_deployment_id` in:" + ) # Select single value single_select <- 1437 # From demer - single_select_df <- get_acoustic_deployments(con, deployment_id = single_select) + single_select_df <- get_acoustic_deployments(deployment_id = single_select) expect_equal( single_select_df %>% distinct(deployment_id) %>% pull(), c(single_select) @@ -79,7 +88,7 @@ test_that("get_acoustic_deployments() allows selecting on deployment_id", { # Select multiple values multi_select <- c("1437", 1588) # Characters are allowed - multi_select_df <- get_acoustic_deployments(con, deployment_id = multi_select) + multi_select_df <- get_acoustic_deployments(deployment_id = multi_select) expect_equal( multi_select_df %>% distinct(deployment_id) %>% pull() %>% sort(), c(as.integer(multi_select)) # Output will be all integer @@ -89,12 +98,18 @@ test_that("get_acoustic_deployments() allows selecting on deployment_id", { test_that("get_acoustic_deployments() allows selecting on receiver_id", { # Errors - expect_error(get_acoustic_deployments(con, receiver_id = "not_a_receiver_id")) - expect_error(get_acoustic_deployments(con, receiver_id = c("VR2W-124070", "not_a_receiver_id"))) + expect_error( + get_acoustic_deployments(receiver_id = "not_a_receiver_id"), + regexp = "Can't find receiver_id `not_a_receiver_id` in" + ) + expect_error( + get_acoustic_deployments(receiver_id = c("VR2W-124070", "not_a_receiver_id")), + regexp = "Can't find receiver_id `VR2W-124070` and/or `not_a_receiver_id` in" + ) # Select single value single_select <- "VR2W-124070" # From demer - single_select_df <- get_acoustic_deployments(con, receiver_id = single_select) + single_select_df <- get_acoustic_deployments(receiver_id = single_select) expect_equal( single_select_df %>% distinct(receiver_id) %>% pull(), c(single_select) @@ -103,7 +118,7 @@ test_that("get_acoustic_deployments() allows selecting on receiver_id", { # Select multiple values multi_select <- c("VR2W-124070", "VR2W-124078") - multi_select_df <- get_acoustic_deployments(con, receiver_id = multi_select) + multi_select_df <- get_acoustic_deployments(receiver_id = multi_select) expect_equal( multi_select_df %>% distinct(receiver_id) %>% pull() %>% sort(), c(multi_select) @@ -113,12 +128,18 @@ test_that("get_acoustic_deployments() allows selecting on receiver_id", { test_that("get_acoustic_deployments() allows selecting on acoustic_project_code", { # Errors - expect_error(get_acoustic_deployments(con, acoustic_project_code = "not_a_project")) - expect_error(get_acoustic_deployments(con, acoustic_project_code = c("demer", "not_a_project"))) + expect_error( + get_acoustic_deployments(acoustic_project_code = "not_a_project"), + regexp = "Can't find acoustic_project_code `not_a_project` in" + ) + expect_error( + get_acoustic_deployments(acoustic_project_code = c("demer", "not_a_project")), + regexp = "Can't find acoustic_project_code `demer` and/or `not_a_project` in" + ) # Select single value single_select <- "demer" - single_select_df <- get_acoustic_deployments(con, acoustic_project_code = single_select) + single_select_df <- get_acoustic_deployments(acoustic_project_code = single_select) expect_equal( single_select_df %>% distinct(acoustic_project_code) %>% pull(), c(single_select) @@ -127,13 +148,13 @@ test_that("get_acoustic_deployments() allows selecting on acoustic_project_code" # Selection is case insensitive expect_equal( - get_acoustic_deployments(con, acoustic_project_code = "demer"), - get_acoustic_deployments(con, acoustic_project_code = "DEMER") + get_acoustic_deployments(acoustic_project_code = "demer"), + get_acoustic_deployments(acoustic_project_code = "DEMER") ) # Select multiple values multi_select <- c("demer", "dijle") - multi_select_df <- get_acoustic_deployments(con, acoustic_project_code = multi_select) + multi_select_df <- get_acoustic_deployments(acoustic_project_code = multi_select) expect_equal( multi_select_df %>% distinct(acoustic_project_code) %>% pull() %>% sort(), c(multi_select) @@ -143,12 +164,18 @@ test_that("get_acoustic_deployments() allows selecting on acoustic_project_code" test_that("get_acoustic_deployments() allows selecting on station_name", { # Errors - expect_error(get_acoustic_deployments(con, station_name = "not_a_station_name")) - expect_error(get_acoustic_deployments(con, station_name = c("de-9", "not_a_station_name"))) + expect_error( + get_acoustic_deployments(station_name = "not_a_station_name"), + regexp = "Can't find station_name `not_a_station_name` in" + ) + expect_error( + get_acoustic_deployments(station_name = c("de-9", "not_a_station_name")), + regexp = "Can't find station_name `de-9` and/or `not_a_station_name` in" + ) # Select single value single_select <- "de-9" # From demer - single_select_df <- get_acoustic_deployments(con, station_name = single_select) + single_select_df <- get_acoustic_deployments(station_name = single_select) expect_equal( single_select_df %>% distinct(station_name) %>% pull(), c(single_select) @@ -157,7 +184,7 @@ test_that("get_acoustic_deployments() allows selecting on station_name", { # Select multiple values multi_select <- c("de-10", "de-9") # Note that sort() will put de-10 before de-9 - multi_select_df <- get_acoustic_deployments(con, station_name = multi_select) + multi_select_df <- get_acoustic_deployments(station_name = multi_select) expect_equal( multi_select_df %>% distinct(station_name) %>% pull() %>% sort(), c(multi_select) @@ -167,24 +194,27 @@ test_that("get_acoustic_deployments() allows selecting on station_name", { test_that("get_acoustic_deployments() allows selecting on open deployments only", { # Errors - expect_error(get_acoustic_deployments(con, open_only = "not_a_logical")) + expect_error( + get_acoustic_deployments(open_only = "not_a_logical"), + regexp = "argument is not interpretable as logical" + ) # ws1 is an open ended acoustic project - all_df <- get_acoustic_deployments(con, acoustic_project_code = "ws1", open_only = FALSE) + all_df <- + get_acoustic_deployments(acoustic_project_code = "ws1", open_only = FALSE) # Default returns all - default_df <- get_acoustic_deployments(con, acoustic_project_code = "ws1") + default_df <- get_acoustic_deployments(acoustic_project_code = "ws1") expect_equal(default_df, all_df) # Open only returns deployments with no end date - open_only_df <- get_acoustic_deployments(con, acoustic_project_code = "ws1", open_only = TRUE) + open_only_df <- get_acoustic_deployments(acoustic_project_code = "ws1", open_only = TRUE) expect_lt(nrow(open_only_df), nrow(all_df)) expect_true(all(is.na(open_only_df$recover_date_time))) }) test_that("get_acoustic_deployments() allows selecting on multiple parameters", { multiple_parameters_df <- get_acoustic_deployments( - con, receiver_id = "VR2W-124070", acoustic_project_code = "demer", station_name = "de-9", @@ -195,6 +225,75 @@ test_that("get_acoustic_deployments() allows selecting on multiple parameters", test_that("get_acoustic_deployments() does not return cpod deployments", { # POD-3330 is a cpod receiver - df <- get_acoustic_deployments(con, receiver_id = "POD-3330") + df <- get_acoustic_deployments(receiver_id = "POD-3330") expect_equal(nrow(df), 0) }) + + +# sql helper tests -------------------------------------------------------- + +test_that("get_acoustic_deployments_sql() returns a tibble", { + df_sql <- get_acoustic_deployments_sql() + expect_s3_class(df_sql, "data.frame") + expect_s3_class(df_sql, "tbl") +}) + +test_that("get_acoustic_deployments_sql() allows selecting on deployment_id", { + # Errors + expect_error( + get_acoustic_deployments_sql(deployment_id = "not_a_deployment_id"), + regexp = "Can't find receiver_id `not_a_deployment_id` in" + ) + expect_error( + get_acoustic_deployments_sql(deployment_id = c("1437", "not_a_deployment_id")), + regexp = "Can't find receiver_id `1437` and/or `not_a_deployment_id` in:" + ) + + # Select single value + single_select <- 1437 # From demer + single_select_df <- get_acoustic_deployments_sql(deployment_id = single_select) + expect_equal( + single_select_df %>% distinct(deployment_id) %>% pull(), + c(single_select) + ) + expect_gt(nrow(single_select_df), 0) + + # Select multiple values + multi_select <- c("1437", 1588) # Characters are allowed + multi_select_df <- get_acoustic_deployments_sql(deployment_id = multi_select) + expect_equal( + multi_select_df %>% distinct(deployment_id) %>% pull() %>% sort(), + c(as.integer(multi_select)) # Output will be all integer + ) + expect_gt(nrow(multi_select_df), nrow(single_select_df)) +}) + +test_that("get_acoustic_deployments_sql() allows selecting on receiver_id", { + # Errors + expect_error( + get_acoustic_deployments_sql(receiver_id = "not_a_receiver_id"), + regexp = "Can't find receiver_id `not_a_receiver_id` in" + ) + expect_error( + get_acoustic_deployments_sql(receiver_id = c("VR2W-124070", "not_a_receiver_id")), + regexp = "Can't find receiver_id `VR2W-124070` and/or `not_a_receiver_id` in" + ) + + # Select single value + single_select <- "VR2W-124070" # From demer + single_select_df <- get_acoustic_deployments_sql(receiver_id = single_select) + expect_equal( + single_select_df %>% distinct(receiver_id) %>% pull(), + c(single_select) + ) + expect_gt(nrow(single_select_df), 0) + + # Select multiple values + multi_select <- c("VR2W-124070", "VR2W-124078") + multi_select_df <- get_acoustic_deployments_sql(receiver_id = multi_select) + expect_equal( + multi_select_df %>% distinct(receiver_id) %>% pull() %>% sort(), + c(multi_select) + ) + expect_gt(nrow(multi_select_df), nrow(single_select_df)) +}) diff --git a/tests/testthat/test-get_acoustic_detections.R b/tests/testthat/test-get_acoustic_detections.R index b490f15e..b6e88d86 100644 --- a/tests/testthat/test-get_acoustic_detections.R +++ b/tests/testthat/test-get_acoustic_detections.R @@ -1,25 +1,36 @@ -con <- connect_to_etn() +# con <- connect_to_etn() -test_that("get_acoustic_detections() returns error for incorrect connection", { +# test_that("get_acoustic_detections() returns error for incorrect connection", { +# expect_error( +# get_acoustic_detections(con = "not_a_connection"), +# "Not a connection object to database." +# ) +# }) + +test_that("get_acoustic_detections() can pass errors over the api", { expect_error( - get_acoustic_detections(con = "not_a_connection"), - "Not a connection object to database." + get_acoustic_detections(start_date = "not_a_date", api = TRUE), + regexp = "The given start_date, not_a_date, is not in a valid date format." ) }) test_that("get_acoustic_detections() returns a tibble", { - df <- get_acoustic_detections(con, limit = TRUE) + df <- get_acoustic_detections(limit = TRUE) expect_s3_class(df, "data.frame") expect_s3_class(df, "tbl") + df_sql <- get_acoustic_detections(limit = TRUE, api = FALSE) + expect_s3_class(df_sql, "data.frame") + expect_s3_class(df_sql, "tbl") }) -test_that("get_acoustic_detections() returns unique detection_id", { - df <- get_acoustic_detections(con, limit = TRUE) - expect_equal(nrow(df), nrow(df %>% distinct(detection_id))) -}) +# TODO check #283 and re-enable test if neccesairy. +# test_that("get_acoustic_detections() returns unique detection_id", { +# df <- get_acoustic_detections(limit = TRUE) +# expect_equal(nrow(df), nrow(df %>% distinct(detection_id))) +# }) test_that("get_acoustic_detections() returns the expected columns", { - df <- get_acoustic_detections(con, limit = TRUE) + df <- get_acoustic_detections(limit = TRUE) expected_col_names <- c( "detection_id", "date_time", @@ -47,47 +58,51 @@ test_that("get_acoustic_detections() returns the expected columns", { test_that("get_acoustic_detections() allows selecting on start_date and end_date", { # Errors - expect_error(get_acoustic_detections(con, start_date = "not_a_date")) - expect_error(get_acoustic_detections(con, end_date = "not_a_date")) + expect_error(get_acoustic_detections(start_date = "not_a_date")) + expect_error(get_acoustic_detections(end_date = "not_a_date")) # 2014_demer contains data from 2014-04-18 15:45:00 UTC to 2018-09-15 19:40:51 UTC # Start date (inclusive) <= min(date_time) - start_year_df <- get_acoustic_detections(con, start_date = "2015", animal_project_code = "2014_demer") + start_year_df <- get_acoustic_detections(start_date = "2015", animal_project_code = "2014_demer") expect_lte(as.POSIXct("2015-01-01", tz = "UTC"), min(start_year_df$date_time)) - start_month_df <- get_acoustic_detections(con, start_date = "2015-04", animal_project_code = "2014_demer") + start_month_df <- get_acoustic_detections(start_date = "2015-04", animal_project_code = "2014_demer") expect_lte(as.POSIXct("2015-04-01", tz = "UTC"), min(start_month_df$date_time)) - start_day_df <- get_acoustic_detections(con, start_date = "2015-04-24", animal_project_code = "2014_demer") + start_day_df <- get_acoustic_detections(start_date = "2015-04-24", animal_project_code = "2014_demer") expect_lte(as.POSIXct("2015-04-24", tz = "UTC"), min(start_day_df$date_time)) # End date (exclusive) > max(date_time) - end_year_df <- get_acoustic_detections(con, end_date = "2016", animal_project_code = "2014_demer") + end_year_df <- get_acoustic_detections(end_date = "2016", animal_project_code = "2014_demer") expect_gt(as.POSIXct("2016-01-01", tz = "UTC"), max(end_year_df$date_time)) - end_month_df <- get_acoustic_detections(con, end_date = "2015-05", animal_project_code = "2014_demer") + end_month_df <- get_acoustic_detections(end_date = "2015-05", animal_project_code = "2014_demer") expect_gt(as.POSIXct("2015-05-01", tz = "UTC"), max(end_month_df$date_time)) - end_day_df <- get_acoustic_detections(con, end_date = "2015-04-25", animal_project_code = "2014_demer") + end_day_df <- get_acoustic_detections(end_date = "2015-04-25", animal_project_code = "2014_demer") expect_gt(as.POSIXct("2015-04-25", tz = "UTC"), max(end_day_df$date_time)) # Between - between_year_df <- get_acoustic_detections(con, start_date= "2015", end_date = "2016", animal_project_code = "2014_demer") + between_year_df <- + get_acoustic_detections( + start_date= "2015", + end_date = "2016", + animal_project_code = "2014_demer") expect_lte(as.POSIXct("2015-01-01", tz = "UTC"), min(between_year_df$date_time)) expect_gt(as.POSIXct("2016-01-01", tz = "UTC"), max(between_year_df$date_time)) - between_month_df <- get_acoustic_detections(con, start_date = "2015-04", end_date = "2015-05", animal_project_code = "2014_demer") + between_month_df <- get_acoustic_detections(start_date = "2015-04", end_date = "2015-05", animal_project_code = "2014_demer") expect_lte(as.POSIXct("2015-04-01", tz = "UTC"), min(between_month_df$date_time)) expect_gt(as.POSIXct("2015-05-01", tz = "UTC"), max(between_month_df$date_time)) - between_day_df <- get_acoustic_detections(con, start_date = "2015-04-24", end_date = "2015-04-25", animal_project_code = "2014_demer") + between_day_df <- get_acoustic_detections(start_date = "2015-04-24", end_date = "2015-04-25", animal_project_code = "2014_demer") expect_lte(as.POSIXct("2015-04-24", tz = "UTC"), min(between_day_df$date_time)) expect_gt(as.POSIXct("2015-04-25", tz = "UTC"), max(between_day_df$date_time)) }) test_that("get_acoustic_detections() allows selecting on acoustic_tag_id", { # Errors - expect_error(get_acoustic_detections(con, acoustic_tag_id = "not_a_tag_id")) - expect_error(get_acoustic_detections(con, acoustic_tag_id = c("A69-1601-16130", "not_a_tag_id"))) + expect_error(get_acoustic_detections(acoustic_tag_id = "not_a_tag_id")) + expect_error(get_acoustic_detections(acoustic_tag_id = c("A69-1601-16130", "not_a_tag_id"))) # Select single value single_select <- "A69-1601-16130" # From 2014_demer - single_select_df <- get_acoustic_detections(con, acoustic_tag_id = single_select) + single_select_df <- get_acoustic_detections(acoustic_tag_id = single_select) expect_equal( single_select_df %>% distinct(acoustic_tag_id) %>% pull(), c(single_select) @@ -96,7 +111,7 @@ test_that("get_acoustic_detections() allows selecting on acoustic_tag_id", { # Select multiple values multi_select <- c("A69-1601-16129", "A69-1601-16130") - multi_select_df <- get_acoustic_detections(con, acoustic_tag_id = multi_select) + multi_select_df <- get_acoustic_detections(acoustic_tag_id = multi_select) expect_equal( multi_select_df %>% distinct(acoustic_tag_id) %>% pull() %>% sort(), c(multi_select) @@ -106,12 +121,12 @@ test_that("get_acoustic_detections() allows selecting on acoustic_tag_id", { test_that("get_acoustic_detections() allows selecting on animal_project_code", { # Errors - expect_error(get_acoustic_detections(con, animal_project_code = "not_a_project")) - expect_error(get_acoustic_detections(con, animal_project_code = c("2014_demer", "not_a_project"))) + expect_error(get_acoustic_detections(animal_project_code = "not_a_project")) + expect_error(get_acoustic_detections(animal_project_code = c("2014_demer", "not_a_project"))) # Select single value single_select <- "2014_demer" - single_select_df <- get_acoustic_detections(con, animal_project_code = single_select) + single_select_df <- get_acoustic_detections(animal_project_code = single_select) expect_equal( single_select_df %>% distinct(animal_project_code) %>% pull(), c(single_select) @@ -120,13 +135,21 @@ test_that("get_acoustic_detections() allows selecting on animal_project_code", { # Selection is case insensitive expect_equal( - get_acoustic_detections(con, animal_project_code = "2014_demer", limit = TRUE), - get_acoustic_detections(con, animal_project_code = "2014_DEMER", limit = TRUE) + get_acoustic_detections( + animal_project_code = "2014_demer", + start_date = "2015-09-07", + end_date = "2015-09-08" + ), + get_acoustic_detections( + animal_project_code = "2014_DEMER", + start_date = "2015-09-07", + end_date = "2015-09-08" + ) ) # Select multiple values multi_select <- c("2014_demer", "2015_dijle") - multi_select_df <- get_acoustic_detections(con, animal_project_code = multi_select) + multi_select_df <- get_acoustic_detections(animal_project_code = multi_select) expect_equal( multi_select_df %>% distinct(animal_project_code) %>% pull() %>% sort(), c(multi_select) @@ -136,13 +159,13 @@ test_that("get_acoustic_detections() allows selecting on animal_project_code", { test_that("get_acoustic_detections() allows selecting on scientific_name", { # Errors - expect_error(get_acoustic_detections(con, scientific_name = "not_a_sciname")) - expect_error(get_acoustic_detections(con, scientific_name = "rutilus rutilus")) # Case sensitive - expect_error(get_acoustic_detections(con, scientific_name = c("Rutilus rutilus", "not_a_sciname"))) + expect_error(get_acoustic_detections(scientific_name = "not_a_sciname")) + expect_error(get_acoustic_detections(scientific_name = "rutilus rutilus")) # Case sensitive + expect_error(get_acoustic_detections(scientific_name = c("Rutilus rutilus", "not_a_sciname"))) # Select single value single_select <- "Rutilus rutilus" - single_select_df <- get_acoustic_detections(con, scientific_name = single_select) + single_select_df <- get_acoustic_detections(scientific_name = single_select) expect_equal( single_select_df %>% distinct(scientific_name) %>% pull(), c(single_select) @@ -151,7 +174,7 @@ test_that("get_acoustic_detections() allows selecting on scientific_name", { # Select multiple values multi_select <- c("Rutilus rutilus", "Silurus glanis") - multi_select_df <- get_acoustic_detections(con, scientific_name = multi_select) + multi_select_df <- get_acoustic_detections(scientific_name = multi_select) expect_equal( multi_select_df %>% distinct(scientific_name) %>% pull() %>% sort(), c(multi_select) @@ -161,12 +184,13 @@ test_that("get_acoustic_detections() allows selecting on scientific_name", { test_that("get_acoustic_detections() allows selecting on acoustic_project_code", { # Errors - expect_error(get_acoustic_detections(con, acoustic_project_code = "not_a_project")) - expect_error(get_acoustic_detections(con, acoustic_project_code = c("demer", "not_a_project"))) + expect_error(get_acoustic_detections(acoustic_project_code = "not_a_project")) + expect_error(get_acoustic_detections(acoustic_project_code = c("demer", "not_a_project"))) # Select single value single_select <- "demer" - single_select_df <- get_acoustic_detections(con, acoustic_project_code = single_select) + single_select_df <- get_acoustic_detections(acoustic_project_code = single_select, + limit = TRUE) expect_equal( single_select_df %>% distinct(acoustic_project_code) %>% pull(), c(single_select) @@ -175,13 +199,21 @@ test_that("get_acoustic_detections() allows selecting on acoustic_project_code", # Selection is case insensitive expect_equal( - get_acoustic_detections(con, acoustic_project_code = "demer", limit = TRUE), - get_acoustic_detections(con, acoustic_project_code = "DEMER", limit = TRUE) + get_acoustic_detections( + acoustic_project_code = "demer", + start_date = "2014-04-28", + end_date = "2014-04-30" + ), + get_acoustic_detections( + acoustic_project_code = "DEMER", + start_date = "2014-04-28", + end_date = "2014-04-30" + ) ) # Select multiple values multi_select <- c("demer", "dijle") - multi_select_df <- get_acoustic_detections(con, acoustic_project_code = multi_select) + multi_select_df <- get_acoustic_detections(acoustic_project_code = multi_select) expect_equal( multi_select_df %>% distinct(acoustic_project_code) %>% pull() %>% sort(), c(multi_select) @@ -191,12 +223,12 @@ test_that("get_acoustic_detections() allows selecting on acoustic_project_code", test_that("get_acoustic_detections() allows selecting on receiver_id", { # Errors - expect_error(get_acoustic_detections(con, receiver_id = "not_a_receiver_id")) - expect_error(get_acoustic_detections(con, receiver_id = c("VR2W-124070", "not_a_receiver_id"))) + expect_error(get_acoustic_detections(receiver_id = "not_a_receiver_id")) + expect_error(get_acoustic_detections(receiver_id = c("VR2W-124070", "not_a_receiver_id"))) # Select single value single_select <- "VR2W-124070" # From demer - single_select_df <- get_acoustic_detections(con, receiver_id = single_select) + single_select_df <- get_acoustic_detections(receiver_id = single_select) expect_equal( single_select_df %>% distinct(receiver_id) %>% pull(), c(single_select) @@ -205,7 +237,7 @@ test_that("get_acoustic_detections() allows selecting on receiver_id", { # Select multiple values multi_select <- c("VR2W-124070", "VR2W-124078") - multi_select_df <- get_acoustic_detections(con, receiver_id = multi_select) + multi_select_df <- get_acoustic_detections(receiver_id = multi_select) expect_equal( multi_select_df %>% distinct(receiver_id) %>% pull() %>% sort(), c(multi_select) @@ -215,12 +247,12 @@ test_that("get_acoustic_detections() allows selecting on receiver_id", { test_that("get_acoustic_detections() allows selecting on station_name", { # Errors - expect_error(get_acoustic_detections(con, station_name = "not_a_station_name")) - expect_error(get_acoustic_detections(con, station_name = c("de-9", "not_a_station_name"))) + expect_error(get_acoustic_detections(station_name = "not_a_station_name")) + expect_error(get_acoustic_detections(station_name = c("de-9", "not_a_station_name"))) # Select single value single_select <- "de-9" # From demer - single_select_df <- get_acoustic_detections(con, station_name = single_select) + single_select_df <- get_acoustic_detections(station_name = single_select) expect_equal( single_select_df %>% distinct(station_name) %>% pull(), c(single_select) @@ -229,7 +261,7 @@ test_that("get_acoustic_detections() allows selecting on station_name", { # Select multiple values multi_select <- c("de-10", "de-9") # Note that sort() will put de-10 before de-9 - multi_select_df <- get_acoustic_detections(con, station_name = multi_select) + multi_select_df <- get_acoustic_detections(station_name = multi_select) expect_equal( multi_select_df %>% distinct(station_name) %>% pull() %>% sort(), c(multi_select) @@ -239,19 +271,18 @@ test_that("get_acoustic_detections() allows selecting on station_name", { test_that("get_acoustic_detections() allows to limit to 100 records", { # Errors - expect_error(get_acoustic_detections(con, limit = "not_a_logical")) + expect_error(get_acoustic_detections(limit = "not_a_logical")) # Limit - expect_equal(nrow(get_acoustic_detections(con, limit = TRUE)), 100) + expect_equal(nrow(get_acoustic_detections(limit = TRUE)), 100) expect_equal( - nrow(get_acoustic_detections(con, acoustic_project_code = "demer", limit = TRUE)), + nrow(get_acoustic_detections(acoustic_project_code = "demer", limit = TRUE)), 100 ) }) test_that("get_acoustic_detections() allows selecting on multiple parameters", { multiple_parameters_df <- get_acoustic_detections( - con, start_date = "2014-04-24", end_date = "2014-04-25", acoustic_tag_id = "A69-1601-16130", @@ -265,11 +296,11 @@ test_that("get_acoustic_detections() allows selecting on multiple parameters", { }) test_that("get_acoustic_detections() returns acoustic and acoustic-archival tags", { - acoustic_df <- get_acoustic_detections(con, acoustic_tag_id = "A69-1601-16130") + acoustic_df <- get_acoustic_detections(acoustic_tag_id = "A69-1601-16130") expect_gt(nrow(acoustic_df), 0) # A sentinel acoustic-archival tag with pressure + temperature sensor - acoustic_archival_df <- get_acoustic_detections(con, acoustic_tag_id = c("A69-9006-11100", "A69-9006-11099")) + acoustic_archival_df <- get_acoustic_detections(acoustic_tag_id = c("A69-9006-11100", "A69-9006-11099")) expect_gt(nrow(acoustic_archival_df), 0) expect_equal( acoustic_archival_df %>% distinct(tag_serial_number) %>% pull(), @@ -300,7 +331,7 @@ test_that("get_acoustic_detections() does not return duplicate detections across # 1228004 | A69-1105-100 | S256-100 | 720 | 2015-12-01 00:00 | 2013 Albertkanaal # Expect no duplicates - df <- get_acoustic_detections(con, acoustic_tag_id = "A69-1105-100") + df <- get_acoustic_detections(acoustic_tag_id = "A69-1105-100") # expect_equal(nrow(df), nrow(df %>% distinct(detection_id))) # TODO: https://github.com/inbo/etn/issues/216 }) @@ -310,9 +341,9 @@ test_that("get_acoustic_detections() does not return duplicate detections when t # - 394 (2012_leopoldkanaal) from 2012-12-14 13:30:00 to open # Detections should be joined with acoustic_tag_id AND datetime, so that they # are not duplicated. Note: for df_393 we use a start_date to limit records. - df_both <- get_acoustic_detections(con, acoustic_tag_id = "A69-1601-29925") - df_393 <- get_acoustic_detections(con, acoustic_tag_id = "A69-1601-29925", start_date = "2012-12-01", end_date = "2012-12-10") - df_394 <- get_acoustic_detections(con, acoustic_tag_id = "A69-1601-29925", start_date = "2012-12-14") + df_both <- get_acoustic_detections(acoustic_tag_id = "A69-1601-29925") + df_393 <- get_acoustic_detections(acoustic_tag_id = "A69-1601-29925", start_date = "2012-12-01", end_date = "2012-12-10") + df_394 <- get_acoustic_detections(acoustic_tag_id = "A69-1601-29925", start_date = "2012-12-14") # Expect no duplicates expect_equal(nrow(df_both), nrow(df_both %>% distinct(detection_id))) @@ -325,9 +356,9 @@ test_that("get_acoustic_detections() does not return duplicate detections when t test_that("get_acoustic_detections() does not return detections out of date range when tag is associated with animal", { # A69-1303-20695 (tag_serial_number = 1097335) is associated with animal # 637 (2010_phd_reubens) from 2010-08-09 13:00:00 to 2011-05-19 00:00:00 - in_range_df <- get_acoustic_detections(con, acoustic_tag_id = "A69-1303-20695", start_date = "2010-08-09", end_date = "2011-05-19") - pre_range_df <- get_acoustic_detections(con, acoustic_tag_id = "A69-1303-20695", end_date = "2010-08-09") - post_range_df <- get_acoustic_detections(con, acoustic_tag_id = "A69-1303-20695", start_date = "2011-05-19") + in_range_df <- get_acoustic_detections(acoustic_tag_id = "A69-1303-20695", start_date = "2010-08-09", end_date = "2011-05-19") + pre_range_df <- get_acoustic_detections(acoustic_tag_id = "A69-1303-20695", end_date = "2010-08-09") + post_range_df <- get_acoustic_detections(acoustic_tag_id = "A69-1303-20695", start_date = "2011-05-19") # Expect detections within range expect_gt(nrow(in_range_df), 0) @@ -340,5 +371,5 @@ test_that("get_acoustic_detections() does not return detections out of date rang test_that("get_acoustic_detections() can return detections not (yet) associated with an animal", { # A180-1702-49684 (tag_serial_number = 1317386) is an "acoustic / animal" tag # not yet associated with an animal. It should return detections - expect_gt(nrow(get_acoustic_detections(con, acoustic_tag_id = "A180-1702-49684")), 0) + expect_gt(nrow(get_acoustic_detections(acoustic_tag_id = "A180-1702-49684")), 0) }) diff --git a/tests/testthat/test-get_acoustic_projects.R b/tests/testthat/test-get_acoustic_projects.R index 7f4bba91..88040989 100644 --- a/tests/testthat/test-get_acoustic_projects.R +++ b/tests/testthat/test-get_acoustic_projects.R @@ -1,25 +1,27 @@ -con <- connect_to_etn() - -test_that("get_acoustic_projects() returns error for incorrect connection", { - expect_error( - get_acoustic_projects(con = "not_a_connection"), - "Not a connection object to database." - ) -}) - +# con <- connect_to_etn() +# +# test_that("get_acoustic_projects() returns error for incorrect connection", { +# expect_error( +# get_acoustic_projects(con = "not_a_connection"), +# "Not a connection object to database." +# ) +# }) +df <- get_acoustic_projects() +df_sql <- get_acoustic_projects(api = FALSE) test_that("get_acoustic_projects() returns a tibble", { - df <- get_acoustic_projects(con) expect_s3_class(df, "data.frame") expect_s3_class(df, "tbl") + expect_s3_class(df_sql, "data.frame") + expect_s3_class(df_sql, "tbl") }) test_that("get_acoustic_projects() returns unique project_id", { - df <- get_acoustic_projects(con) + # df <- get_acoustic_projects() expect_equal(nrow(df), nrow(df %>% distinct(project_id))) }) test_that("get_acoustic_projects() returns the expected columns", { - df <- get_acoustic_projects(con) + # df <- get_acoustic_projects() expected_col_names <- c( "project_id", "project_code", @@ -41,12 +43,18 @@ test_that("get_acoustic_projects() returns the expected columns", { test_that("get_acoustic_projects() allows selecting on acoustic_project_code", { # Errors - expect_error(get_acoustic_projects(con, acoustic_project_code = "not_a_project")) - expect_error(get_acoustic_projects(con, acoustic_project_code = c("demer", "not_a_project"))) + expect_error( + get_acoustic_projects(acoustic_project_code = "not_a_project"), + regexp = "Can't find acoustic_project_code `not_a_project` in" + ) + expect_error( + get_acoustic_projects(acoustic_project_code = c("demer", "not_a_project")), + regexp = "Can't find acoustic_project_code `demer` and/or `not_a_project` in" + ) # Select single value single_select <- "demer" - single_select_df <- get_acoustic_projects(con, acoustic_project_code = single_select) + single_select_df <- get_acoustic_projects(acoustic_project_code = single_select) expect_equal( single_select_df %>% distinct(project_code) %>% pull(), c(single_select) @@ -55,13 +63,13 @@ test_that("get_acoustic_projects() allows selecting on acoustic_project_code", { # Selection is case insensitive expect_equal( - get_acoustic_projects(con, acoustic_project_code = "demer"), - get_acoustic_projects(con, acoustic_project_code = "DEMER") + get_acoustic_projects(acoustic_project_code = "demer"), + get_acoustic_projects(acoustic_project_code = "DEMER") ) # Select multiple values multi_select <- c("demer", "dijle") - multi_select_df <- get_acoustic_projects(con, acoustic_project_code = multi_select) + multi_select_df <- get_acoustic_projects(acoustic_project_code = multi_select) expect_equal( multi_select_df %>% distinct(project_code) %>% pull() %>% sort(), c(multi_select) @@ -71,7 +79,7 @@ test_that("get_acoustic_projects() allows selecting on acoustic_project_code", { test_that("get_acoustic_projects() returns projects of type 'acoustic'", { expect_equal( - get_acoustic_projects(con) %>% distinct(project_type) %>% pull(), + get_acoustic_projects() %>% distinct(project_type) %>% pull(), "acoustic" ) }) diff --git a/tests/testthat/test-get_acoustic_receivers.R b/tests/testthat/test-get_acoustic_receivers.R index a56ed6d6..fbe694bb 100644 --- a/tests/testthat/test-get_acoustic_receivers.R +++ b/tests/testthat/test-get_acoustic_receivers.R @@ -1,16 +1,19 @@ -con <- connect_to_etn() - -test_that("get_acoustic_receivers() returns error for incorrect connection", { - expect_error( - get_acoustic_receivers(con = "not_a_connection"), - "Not a connection object to database." - ) -}) +# con <- connect_to_etn() +# +# test_that("get_acoustic_receivers() returns error for incorrect connection", { +# expect_error( +# get_acoustic_receivers(con = "not_a_connection"), +# "Not a connection object to database." +# ) +# }) test_that("get_acoustic_receivers() returns a tibble", { - df <- get_acoustic_receivers(con) + df <- get_acoustic_receivers() expect_s3_class(df, "data.frame") expect_s3_class(df, "tbl") + df_sql <- get_acoustic_receivers(api = FALSE) + expect_s3_class(df_sql, "data.frame") + expect_s3_class(df_sql, "tbl") }) # TODO: re-enable after https://github.com/inbo/etn/issues/251 @@ -20,7 +23,7 @@ test_that("get_acoustic_receivers() returns a tibble", { # }) test_that("get_acoustic_receivers() returns the expected columns", { - df <- get_acoustic_receivers(con) + df <- get_acoustic_receivers() expected_col_names <- c( "receiver_id", "manufacturer", @@ -51,12 +54,18 @@ test_that("get_acoustic_receivers() returns the expected columns", { test_that("get_acoustic_receivers() allows selecting on receiver_id", { # Errors - expect_error(get_acoustic_receivers(con, receiver_id = "not_a_receiver_id")) - expect_error(get_acoustic_receivers(con, receiver_id = c("VR2W-124070", "not_a_receiver_id"))) + expect_error( + get_acoustic_receivers(receiver_id = "not_a_receiver_id"), + regexp = "Can't find receiver_id `not_a_receiver_id` in" + ) + expect_error( + get_acoustic_receivers(receiver_id = c("VR2W-124070", "not_a_receiver_id")), + regexp = "Can't find receiver_id `VR2W-124070` and/or `not_a_receiver_id` in" + ) # Select single value single_select <- "VR2W-124070" # From demer - single_select_df <- get_acoustic_receivers(con, receiver_id = single_select) + single_select_df <- get_acoustic_receivers(receiver_id = single_select) expect_equal( single_select_df %>% distinct(receiver_id) %>% pull(), c(single_select) @@ -65,7 +74,7 @@ test_that("get_acoustic_receivers() allows selecting on receiver_id", { # Select multiple values multi_select <- c("VR2W-124070", "VR2W-124078") - multi_select_df <- get_acoustic_receivers(con, receiver_id = multi_select) + multi_select_df <- get_acoustic_receivers(receiver_id = multi_select) expect_equal( multi_select_df %>% distinct(receiver_id) %>% pull() %>% sort(), c(multi_select) @@ -77,12 +86,18 @@ test_that("get_acoustic_receivers() allows selecting on receiver_id", { test_that("get_acoustic_receivers() allows selecting on status", { # Errors - expect_error(get_acoustic_receivers(con, status = "not_a_status")) - expect_error(get_acoustic_receivers(con, status = c("broken", "not_a_status"))) + expect_error( + get_acoustic_receivers(status = "not_a_status"), + regexp = "Can't find status `not_a_status` in" + ) + expect_error( + get_acoustic_receivers(status = c("broken", "not_a_status")), + regexp = "Can't find status `broken` and/or `not_a_status` in" + ) # Select single value single_select <- "broken" - single_select_df <- get_acoustic_receivers(con, status = single_select) + single_select_df <- get_acoustic_receivers(status = single_select) expect_equal( single_select_df %>% distinct(status) %>% pull(), c(single_select) @@ -91,7 +106,7 @@ test_that("get_acoustic_receivers() allows selecting on status", { # Select multiple values multi_select <- c("broken", "lost") - multi_select_df <- get_acoustic_receivers(con, status = multi_select) + multi_select_df <- get_acoustic_receivers(status = multi_select) expect_equal( multi_select_df %>% distinct(status) %>% pull() %>% sort(), c(multi_select) @@ -101,6 +116,6 @@ test_that("get_acoustic_receivers() allows selecting on status", { test_that("get_acoustic_receivers() does not return cpod receivers", { # POD-3330 is a cpod receiver - df <- get_acoustic_receivers(con, receiver_id = "POD-3330") + df <- get_acoustic_receivers(receiver_id = "POD-3330") expect_equal(nrow(df), 0) }) diff --git a/tests/testthat/test-get_animal_projects.R b/tests/testthat/test-get_animal_projects.R index 4dec0449..2a2b40e1 100644 --- a/tests/testthat/test-get_animal_projects.R +++ b/tests/testthat/test-get_animal_projects.R @@ -1,25 +1,28 @@ -con <- connect_to_etn() - -test_that("get_animal_projects() returns error for incorrect connection", { - expect_error( - get_animal_projects(con = "not_a_connection"), - "Not a connection object to database." - ) -}) +# con <- connect_to_etn() +# +# test_that("get_animal_projects() returns error for incorrect connection", { +# expect_error( +# get_animal_projects(con = "not_a_connection"), +# "Not a connection object to database." +# ) +# }) test_that("get_animal_projects() returns a tibble", { - df <- get_animal_projects(con) + df <- get_animal_projects() expect_s3_class(df, "data.frame") expect_s3_class(df, "tbl") + df_sql <- get_animal_projects(api = FALSE) + expect_s3_class(df_sql, "data.frame") + expect_s3_class(df_sql, "tbl") }) test_that("get_animal_projects() returns unique project_id", { - df <- get_animal_projects(con) + df <- get_animal_projects() expect_equal(nrow(df), nrow(df %>% distinct(project_id))) }) test_that("get_animal_projects() returns the expected columns", { - df <- get_animal_projects(con) + df <- get_animal_projects() expected_col_names <- c( "project_id", "project_code", @@ -41,12 +44,18 @@ test_that("get_animal_projects() returns the expected columns", { test_that("get_animal_projects() allows selecting on animal_project_code", { # Errors - expect_error(get_animal_projects(con, animal_project_code = "not_a_project")) - expect_error(get_animal_projects(con, animal_project_code = c("2014_demer", "not_a_project"))) + expect_error( + get_animal_projects(animal_project_code = "not_a_project"), + regexp = "Can't find animal_project_code `not_a_project` in" + ) + expect_error( + get_animal_projects(animal_project_code = c("2014_demer", "not_a_project")), + regexp = "Can't find animal_project_code `2014_demer` and/or `not_a_project` in" + ) # Select single value single_select <- "2014_demer" - single_select_df <- get_animal_projects(con, animal_project_code = single_select) + single_select_df <- get_animal_projects(animal_project_code = single_select) expect_equal( single_select_df %>% distinct(project_code) %>% pull(), c(single_select) @@ -55,13 +64,13 @@ test_that("get_animal_projects() allows selecting on animal_project_code", { # Selection is case insensitive expect_equal( - get_animal_projects(con, animal_project_code = "2014_demer"), - get_animal_projects(con, animal_project_code = "2014_DEMER") + get_animal_projects(animal_project_code = "2014_demer"), + get_animal_projects(animal_project_code = "2014_DEMER") ) # Select multiple values multi_select <- c("2014_demer", "2015_dijle") - multi_select_df <- get_animal_projects(con, animal_project_code = multi_select) + multi_select_df <- get_animal_projects(animal_project_code = multi_select) expect_equal( multi_select_df %>% distinct(project_code) %>% pull() %>% sort(), c(multi_select) @@ -71,7 +80,7 @@ test_that("get_animal_projects() allows selecting on animal_project_code", { test_that("get_animal_projects() returns projects of type 'animal'", { expect_equal( - get_animal_projects(con) %>% distinct(project_type) %>% pull(), + get_animal_projects() %>% distinct(project_type) %>% pull(), "animal" ) }) diff --git a/tests/testthat/test-get_animals.R b/tests/testthat/test-get_animals.R index 38159a3f..58a3a1b6 100644 --- a/tests/testthat/test-get_animals.R +++ b/tests/testthat/test-get_animals.R @@ -1,25 +1,27 @@ -con <- connect_to_etn() +# con <- connect_to_etn() +# +# test_that("get_animals() returns error for incorrect connection", { +# expect_error( +# get_animals(con = "not_a_connection"), +# "Not a connection object to database." +# ) +# }) -test_that("get_animals() returns error for incorrect connection", { - expect_error( - get_animals(con = "not_a_connection"), - "Not a connection object to database." - ) -}) +df <- get_animals() test_that("get_animals() returns a tibble", { - df <- get_animals(con) expect_s3_class(df, "data.frame") expect_s3_class(df, "tbl") + df_sql <- get_animals(api = FALSE) + expect_s3_class(df_sql, "data.frame") + expect_s3_class(df_sql, "tbl") }) test_that("get_animals() returns unique animal_id", { - df <- get_animals(con) expect_equal(nrow(df), nrow(df %>% distinct(animal_id))) }) test_that("get_animals() returns the expected columns", { - df <- get_animals(con) expected_col_names <- c( "animal_id", "animal_project_code", @@ -93,13 +95,22 @@ test_that("get_animals() returns the expected columns", { test_that("get_animals() allows selecting on animal_id", { # Errors - expect_error(get_animals(con, animal_id = 0)) # Not an existing value - expect_error(get_animals(con, animal_id = c(305, 0))) - expect_error(get_animals(con, animal_id = 20.2)) # Not an integer + expect_error( + get_animals(animal_id = 0), + regexp = "Can't find animal_id `0` in" + ) # Not an existing value + expect_error( + get_animals(animal_id = c(305, 0)), + regexp = "Can't find animal_id `305` and/or `0` in" + ) + expect_error( + get_animals(animal_id = 20.2), + regexp = "Can't find animal_id `20.2` in" + ) # Not an integer # Select single value single_select <- 305 - single_select_df <- get_animals(con, animal_id = single_select) + single_select_df <- get_animals(animal_id = single_select) expect_equal( single_select_df %>% distinct(animal_id) %>% pull(), c(single_select) @@ -108,7 +119,7 @@ test_that("get_animals() allows selecting on animal_id", { # Select multiple values multi_select <- c(304, "305") # Characters are allowed - multi_select_df <- get_animals(con, animal_id = multi_select) + multi_select_df <- get_animals(animal_id = multi_select) expect_equal( multi_select_df %>% distinct(animal_id) %>% pull() %>% sort(), c(as.integer(multi_select)) # Output will be all integer @@ -118,12 +129,18 @@ test_that("get_animals() allows selecting on animal_id", { test_that("get_animals() allows selecting on animal_project_code", { # Errors - expect_error(get_animals(con, animal_project_code = "not_a_project")) - expect_error(get_animals(con, animal_project_code = c("2014_demer", "not_a_project"))) + expect_error( + get_animals(animal_project_code = "not_a_project"), + regexp = "Can't find animal_project_code `not_a_project` in" + ) + expect_error( + get_animals(animal_project_code = c("2014_demer", "not_a_project")), + regexp = "Can't find animal_project_code `2014_demer` and/or `not_a_project` in" + ) # Select single value single_select <- "2014_demer" - single_select_df <- get_animals(con, animal_project_code = single_select) + single_select_df <- get_animals(animal_project_code = single_select) expect_equal( single_select_df %>% distinct(animal_project_code) %>% pull(), c(single_select) @@ -132,13 +149,13 @@ test_that("get_animals() allows selecting on animal_project_code", { # Selection is case insensitive expect_equal( - get_animals(con, animal_project_code = "2014_demer"), - get_animals(con, animal_project_code = "2014_DEMER") + get_animals(animal_project_code = "2014_demer"), + get_animals(animal_project_code = "2014_DEMER") ) # Select multiple values multi_select <- c("2014_demer", "2015_dijle") - multi_select_df <- get_animals(con, animal_project_code = multi_select) + multi_select_df <- get_animals(animal_project_code = multi_select) expect_equal( multi_select_df %>% distinct(animal_project_code) %>% pull() %>% sort(), c(multi_select) @@ -148,12 +165,18 @@ test_that("get_animals() allows selecting on animal_project_code", { test_that("get_animals() allows selecting on tag_serial_number", { # Errors - expect_error(get_animals(con, tag_serial_number = "0")) # Not an existing value - expect_error(get_animals(con, tag_serial_number = c("1187450", "0"))) + expect_error( + get_animals(tag_serial_number = "0"), + regexp = "Can't find tag_serial_number `0` in" + ) # Not an existing value + expect_error( + get_animals(tag_serial_number = c("1187450", "0")), + regexp = "Can't find tag_serial_number `1187450` and/or `0` in" + ) # Select single value single_select <- "1187450" # From 2014_demer - single_select_df <- get_animals(con, tag_serial_number = single_select) + single_select_df <- get_animals(tag_serial_number = single_select) expect_equal( single_select_df %>% distinct(tag_serial_number) %>% pull(), c(single_select) @@ -163,7 +186,7 @@ test_that("get_animals() allows selecting on tag_serial_number", { # Select multiple values multi_select <- c(1187449, "1187450") # Integers are allowed - multi_select_df <- get_animals(con, tag_serial_number = multi_select) + multi_select_df <- get_animals(tag_serial_number = multi_select) expect_equal( multi_select_df %>% distinct(tag_serial_number) %>% pull() %>% sort(), c(as.character(multi_select)) # Output will be all character @@ -173,13 +196,22 @@ test_that("get_animals() allows selecting on tag_serial_number", { test_that("get_animals() allows selecting on scientific_name", { # Errors - expect_error(get_animals(con, scientific_name = "not_a_sciname")) - expect_error(get_animals(con, scientific_name = "rutilus rutilus")) # Case sensitive - expect_error(get_animals(con, scientific_name = c("Rutilus rutilus", "not_a_sciname"))) + expect_error( + get_animals(scientific_name = "not_a_sciname"), + regexp = "Can't find scientific_name `not_a_sciname` in" + ) + expect_error( + get_animals(scientific_name = "rutilus rutilus"), + regexp = "Can't find scientific_name `rutilus rutilus` in" + ) # Case sensitive + expect_error( + get_animals(scientific_name = c("Rutilus rutilus", "not_a_sciname")), + regexp = "Can't find scientific_name `Rutilus rutilus` and/or `not_a_sciname` in" + ) # Select single value single_select <- "Rutilus rutilus" - single_select_df <- get_animals(con, scientific_name = single_select) + single_select_df <- get_animals(scientific_name = single_select) expect_equal( single_select_df %>% distinct(scientific_name) %>% pull(), c(single_select) @@ -188,7 +220,7 @@ test_that("get_animals() allows selecting on scientific_name", { # Select multiple values multi_select <- c("Rutilus rutilus", "Silurus glanis") - multi_select_df <- get_animals(con, scientific_name = multi_select) + multi_select_df <- get_animals(scientific_name = multi_select) expect_equal( multi_select_df %>% distinct(scientific_name) %>% pull() %>% sort(), c(multi_select) @@ -198,7 +230,6 @@ test_that("get_animals() allows selecting on scientific_name", { test_that("get_animals() allows selecting on multiple parameters", { multiple_parameters_df <- get_animals( - con, animal_project_code = "2014_demer", scientific_name = "Rutilus rutilus" ) @@ -208,7 +239,7 @@ test_that("get_animals() allows selecting on multiple parameters", { test_that("get_animals() collapses multiple associated tags to one row", { # Animal 5841 (project SPAWNSEIS) has 2 associated tags (1280688,1280688) - animal_two_tags_df <- get_animals(con, animal_id = 5841) + animal_two_tags_df <- get_animals(animal_id = 5841) expect_equal(nrow(animal_two_tags_df), 1) # Rows should be collapsed @@ -231,7 +262,6 @@ test_that("get_animals() collapses multiple associated tags to one row", { }) test_that("get_animals() returns correct tag_type and tag_subtype", { - df <- get_animals(con) df <- df %>% filter(!stringr::str_detect(tag_type, ",")) # Remove multiple associated tags df <- df %>% filter(tag_type != "") # TODO: remove after https://github.com/inbo/etn/issues/249 expect_equal( @@ -246,6 +276,6 @@ test_that("get_animals() returns correct tag_type and tag_subtype", { test_that("get_animals() does not return animals without tags", { # All animals should be related with a tag - df <- get_animals(con) + expect_equal(df %>% filter(is.na(tag_serial_number)) %>% nrow(), 0) }) diff --git a/tests/testthat/test-get_cpod_projects.R b/tests/testthat/test-get_cpod_projects.R index be42fc27..21895dc1 100644 --- a/tests/testthat/test-get_cpod_projects.R +++ b/tests/testthat/test-get_cpod_projects.R @@ -1,25 +1,27 @@ -con <- connect_to_etn() - -test_that("get_cpod_projects() returns error for incorrect connection", { - expect_error( - get_cpod_projects(con = "not_a_connection"), - "Not a connection object to database." - ) -}) +# con <- connect_to_etn() +# +# test_that("get_cpod_projects() returns error for incorrect connection", { +# expect_error( +# get_cpod_projects(con = "not_a_connection"), +# "Not a connection object to database." +# ) +# }) +df <- get_cpod_projects() +df_sql <- get_cpod_projects() test_that("get_cpod_projects() returns a tibble", { - df <- get_cpod_projects(con) expect_s3_class(df, "data.frame") expect_s3_class(df, "tbl") + + expect_s3_class(df_sql, "data.frame") + expect_s3_class(df_sql, "tbl") }) test_that("get_cpod_projects() returns unique project_id", { - df <- get_cpod_projects(con) expect_equal(nrow(df), nrow(df %>% distinct(project_id))) }) test_that("get_cpod_projects() returns the expected columns", { - df <- get_cpod_projects(con) expected_col_names <- c( "project_id", "project_code", @@ -41,12 +43,18 @@ test_that("get_cpod_projects() returns the expected columns", { test_that("get_cpod_projects() allows selecting on cpod_project_code", { # Errors - expect_error(get_cpod_projects(con, cpod_project_code = "not_a_project")) - expect_error(get_cpod_projects(con, cpod_project_code = c("cpod-lifewatch", "not_a_project"))) + expect_error( + get_cpod_projects(cpod_project_code = "not_a_project"), + regexp = "Can't find cpod_project_code `not_a_project` in" + ) + expect_error( + get_cpod_projects(cpod_project_code = c("cpod-lifewatch", "not_a_project")), + regexp = "Can't find cpod_project_code `cpod-lifewatch` and/or `not_a_project` in" + ) # Select single value single_select <- "cpod-lifewatch" - single_select_df <- get_cpod_projects(con, cpod_project_code = single_select) + single_select_df <- get_cpod_projects(cpod_project_code = single_select) expect_equal( single_select_df %>% distinct(project_code) %>% pull(), c(single_select) @@ -55,13 +63,13 @@ test_that("get_cpod_projects() allows selecting on cpod_project_code", { # Selection is case insensitive expect_equal( - get_cpod_projects(con, cpod_project_code = "cpod-lifewatch"), - get_cpod_projects(con, cpod_project_code = "CPOD-LIFEWATCH") + get_cpod_projects(cpod_project_code = "cpod-lifewatch"), + get_cpod_projects(cpod_project_code = "CPOD-LIFEWATCH") ) # Select multiple values multi_select <- c("cpod-lifewatch", "cpod-od-natuur") - multi_select_df <- get_cpod_projects(con, cpod_project_code = multi_select) + multi_select_df <- get_cpod_projects(cpod_project_code = multi_select) expect_equal( multi_select_df %>% distinct(project_code) %>% pull() %>% sort(), c(multi_select) @@ -71,7 +79,7 @@ test_that("get_cpod_projects() allows selecting on cpod_project_code", { test_that("get_cpod_projects() returns projects of type 'cpod'", { expect_equal( - get_cpod_projects(con) %>% distinct(project_type) %>% pull(), + get_cpod_projects() %>% distinct(project_type) %>% pull(), "cpod" ) }) diff --git a/tests/testthat/test-get_credentials.R b/tests/testthat/test-get_credentials.R new file mode 100644 index 00000000..30f79b37 --- /dev/null +++ b/tests/testthat/test-get_credentials.R @@ -0,0 +1,19 @@ +test_that("get_credentials() returns list with values from sys.env", { + expect_type( + withr::with_envvar( + list(userid = "testid", + pwd = "testpwd"), + get_credentials() + ), + "list" + ) + expect_identical( + withr::with_envvar( + list(userid = "testid", + pwd = "testpwd"), + get_credentials() + ), + list(username = "testid", + password = "testpwd") + ) +}) diff --git a/tests/testthat/test-get_tags.R b/tests/testthat/test-get_tags.R index 570915aa..604efd9e 100644 --- a/tests/testthat/test-get_tags.R +++ b/tests/testthat/test-get_tags.R @@ -1,20 +1,23 @@ -con <- connect_to_etn() - -test_that("get_tags() returns error for incorrect connection", { - expect_error( - get_tags(con = "not_a_connection"), - "Not a connection object to database." - ) -}) +# con <- connect_to_etn() +# +# test_that("get_tags() returns error for incorrect connection", { +# expect_error( +# get_tags(con = "not_a_connection"), +# "Not a connection object to database." +# ) +# }) +df <- get_tags() +df_sql <- get_tags(api = FALSE) test_that("get_tags() returns a tibble", { - df <- get_tags(con) expect_s3_class(df, "data.frame") expect_s3_class(df, "tbl") + + expect_s3_class(df_sql, "data.frame") + expect_s3_class(df_sql, "tbl") }) test_that("get_tags() returns the expected columns", { - df <- get_tags(con) expected_col_names <- c( "tag_serial_number", "tag_type", @@ -76,12 +79,16 @@ test_that("get_tags() returns the expected columns", { test_that("get_tags() allows selecting on tag_serial_number", { # Errors - expect_error(get_tags(con, tag_serial_number = "0")) # Not an existing value - expect_error(get_tags(con, tag_serial_number = c("1187450", "0"))) + expect_error( + get_tags(tag_serial_number = "0"), + regexp = "Can't find tag_serial_number `0` in") # Not an existing value + expect_error( + get_tags(tag_serial_number = c("1187450", "0")), + regexp = "Can't find tag_serial_number `1187450` and/or `0` in") # Select single value single_select <- "1187450" # From 2014_demer - single_select_df <- get_tags(con, tag_serial_number = single_select) + single_select_df <- get_tags(tag_serial_number = single_select) expect_equal( single_select_df %>% distinct(tag_serial_number) %>% pull(), c(single_select) @@ -91,7 +98,7 @@ test_that("get_tags() allows selecting on tag_serial_number", { # Select multiple values multi_select <- c(1187449, "1187450") # Integers are allowed - multi_select_df <- get_tags(con, tag_serial_number = multi_select) + multi_select_df <- get_tags(tag_serial_number = multi_select) expect_equal( multi_select_df %>% distinct(tag_serial_number) %>% pull() %>% sort(), c(as.character(multi_select)) # Output will be all character @@ -101,12 +108,16 @@ test_that("get_tags() allows selecting on tag_serial_number", { test_that("get_tags() allows selecting on tag_type", { # Errors - expect_error(get_tags(con, tag_type = "not_a_tag_type")) - expect_error(get_tags(con, tag_type = c("archival", "not_a_tag_type"))) + expect_error( + get_tags(tag_type = "not_a_tag_type"), + regexp = "Can't find tag_type `not_a_tag_type` in") + expect_error( + get_tags(tag_type = c("archival", "not_a_tag_type")), + regexp = "Can't find tag_type `archival` and/or `not_a_tag_type` in") # Select single value single_select <- "archival" - single_select_df <- get_tags(con, tag_type = single_select) + single_select_df <- get_tags(tag_type = single_select) expect_equal( single_select_df %>% distinct(tag_type) %>% pull(), c(single_select) @@ -115,7 +126,7 @@ test_that("get_tags() allows selecting on tag_type", { # Select multiple values multi_select <- c("acoustic-archival", "archival") - multi_select_df <- get_tags(con, tag_type = multi_select) + multi_select_df <- get_tags(tag_type = multi_select) expect_equal( multi_select_df %>% distinct(tag_type) %>% pull() %>% sort(), c(multi_select) @@ -125,12 +136,16 @@ test_that("get_tags() allows selecting on tag_type", { test_that("get_tags() allows selecting on tag_subtype", { # Errors - expect_error(get_tags(con, tag_subtype = "not_a_tag_subtype")) - expect_error(get_tags(con, tag_subtype = c("archival", "not_a_tag_subtype"))) + expect_error( + get_tags(tag_subtype = "not_a_tag_subtype"), + regexp = "Can't find tag_subtype `not_a_tag_subtype` in") + expect_error( + get_tags(tag_subtype = c("archival", "not_a_tag_subtype")), + regexp = "Can't find tag_subtype `archival` and/or `not_a_tag_subtype` in") # Select single value single_select <- "built-in" - single_select_df <- get_tags(con, tag_subtype = single_select) + single_select_df <- get_tags(tag_subtype = single_select) expect_equal( single_select_df %>% distinct(tag_subtype) %>% pull(), c(single_select) @@ -139,7 +154,7 @@ test_that("get_tags() allows selecting on tag_subtype", { # Select multiple values multi_select <- c("built-in", "range") - multi_select_df <- get_tags(con, tag_subtype = multi_select) + multi_select_df <- get_tags(tag_subtype = multi_select) expect_equal( multi_select_df %>% distinct(tag_subtype) %>% pull() %>% sort(), c(multi_select) @@ -149,12 +164,16 @@ test_that("get_tags() allows selecting on tag_subtype", { test_that("get_tags() allows selecting on acoustic_tag_id", { # Errors - expect_error(get_tags(con, acoustic_tag_id = "not_a_tag_id")) - expect_error(get_tags(con, acoustic_tag_id = c("A69-1601-16130", "not_a_tag_id"))) + expect_error( + get_tags(acoustic_tag_id = "not_a_tag_id"), + regexp = "Can't find acoustic_tag_id `not_a_tag_id` in") + expect_error( + get_tags(acoustic_tag_id = c("A69-1601-16130", "not_a_tag_id")), + regexp = "Can't find acoustic_tag_id `A69-1601-16130` and/or `not_a_tag_id` in") # Select single value single_select <- "A69-1601-16130" # From 2014_demer - single_select_df <- get_tags(con, acoustic_tag_id = single_select) + single_select_df <- get_tags(acoustic_tag_id = single_select) expect_equal( single_select_df %>% distinct(acoustic_tag_id) %>% pull(), c(single_select) @@ -164,7 +183,7 @@ test_that("get_tags() allows selecting on acoustic_tag_id", { # Select multiple values multi_select <- c("A69-1601-16129", "A69-1601-16130") - multi_select_df <- get_tags(con, acoustic_tag_id = multi_select) + multi_select_df <- get_tags(acoustic_tag_id = multi_select) expect_equal( multi_select_df %>% distinct(acoustic_tag_id) %>% pull() %>% sort(), c(multi_select) @@ -174,7 +193,6 @@ test_that("get_tags() allows selecting on acoustic_tag_id", { test_that("get_tags() allows selecting on multiple parameters", { multiple_parameters_df <- get_tags( - con, tag_serial_number = "1187450", tag_type = "acoustic", tag_subtype = "animal", @@ -185,7 +203,7 @@ test_that("get_tags() allows selecting on multiple parameters", { test_that("get_tags() can return multiple rows for a single tag", { # A sentinel acoustic-archival tag with temperature + pressure sensor - tag_1_df <- get_tags(con, tag_serial_number = 1400185) + tag_1_df <- get_tags(tag_serial_number = 1400185) expect_equal(nrow(tag_1_df), 2) # 2 rows: temperature + presure expect_equal( tag_1_df %>% @@ -201,7 +219,7 @@ test_that("get_tags() can return multiple rows for a single tag", { ) # A built-in acoustic tag with two protocols: https://github.com/inbo/etn/issues/177#issuecomment-925578186 - tag_2_df <- get_tags(con, tag_serial_number = 461076) + tag_2_df <- get_tags(tag_serial_number = 461076) expect_equal(nrow(tag_2_df), 2) # 2 rows: A180 + H170 expect_equal( tag_2_df %>% @@ -218,7 +236,6 @@ test_that("get_tags() can return multiple rows for a single tag", { }) test_that("get_tags() returns correct tag_type and tag_subtype", { - df <- get_tags(con) expect_equal( df %>% distinct(tag_type) %>% pull() %>% sort(), c("acoustic", "acoustic-archival", "archival") diff --git a/tests/testthat/test-list_acoustic_project_codes.R b/tests/testthat/test-list_acoustic_project_codes.R index 03ab45f9..37a80fb7 100644 --- a/tests/testthat/test-list_acoustic_project_codes.R +++ b/tests/testthat/test-list_acoustic_project_codes.R @@ -1,9 +1,7 @@ -con <- connect_to_etn() - test_that("list_acoustic_project_codes() returns unique list of values", { - vector <- list_acoustic_project_codes(con) + vector <- list_acoustic_project_codes() - expect_is(vector, "character") + expect_type(vector, "character") expect_false(any(duplicated(vector))) expect_true(all(!is.na(vector))) diff --git a/tests/testthat/test-list_acoustic_tag_ids.R b/tests/testthat/test-list_acoustic_tag_ids.R index 76a59e3a..ac0ffb19 100644 --- a/tests/testthat/test-list_acoustic_tag_ids.R +++ b/tests/testthat/test-list_acoustic_tag_ids.R @@ -1,9 +1,7 @@ -con <- connect_to_etn() - test_that("list_acoustic_tag_ids() returns unique list of values", { - vector <- list_acoustic_tag_ids(con) + vector <- list_acoustic_tag_ids() - expect_is(vector, "character") + expect_type(vector, "character") expect_false(any(duplicated(vector))) expect_true(all(!is.na(vector))) diff --git a/tests/testthat/test-list_animal_ids.R b/tests/testthat/test-list_animal_ids.R new file mode 100644 index 00000000..30c2c49e --- /dev/null +++ b/tests/testthat/test-list_animal_ids.R @@ -0,0 +1,24 @@ +test_that("list_animal_ids() returns unique list of values", { + result_api <- list_animal_ids() + result_sql <- list_animal_ids(api = FALSE) + expect_type(result_api, "integer") + expect_false(any(duplicated(result_api))) + expect_true(all(!is.na(result_api))) + expect_identical(result_api, result_sql) +}) + +test_that("list_animal_ids returns at least 5 known values", { + result <- list_animal_ids() + + # a set of 5 known id_pk present in common.animal_release + known_ids <- c("56314", "8504", "7601", "4293", "58407") + + testthat::expect_true(all(known_ids %in% result)) +}) + +test_that("list_animal_ids() warns for depreciation of connection", { + # snapshot warning only, not values + expect_snapshot( + animal_ids <- list_animal_ids(connection = "any_object") + ) +}) diff --git a/tests/testthat/test-list_animal_project_codes.R b/tests/testthat/test-list_animal_project_codes.R index ffe197c0..b7827d34 100644 --- a/tests/testthat/test-list_animal_project_codes.R +++ b/tests/testthat/test-list_animal_project_codes.R @@ -1,9 +1,7 @@ -con <- connect_to_etn() - test_that("list_animal_project_codes() returns unique list of values", { - vector <- list_animal_project_codes(con) + vector <- list_animal_project_codes() - expect_is(vector, "character") + expect_type(vector, "character") expect_false(any(duplicated(vector))) expect_true(all(!is.na(vector))) diff --git a/tests/testthat/test-list_cpod_project_codes.R b/tests/testthat/test-list_cpod_project_codes.R index e25d490e..0397123f 100644 --- a/tests/testthat/test-list_cpod_project_codes.R +++ b/tests/testthat/test-list_cpod_project_codes.R @@ -1,9 +1,9 @@ -con <- connect_to_etn() - test_that("list_cpod_project_codes() returns unique list of values", { - vector <- list_cpod_project_codes(con) + vector <- list_cpod_project_codes() + vector_sql <- list_cpod_project_codes(api = FALSE) - expect_is(vector, "character") + expect_type(vector, "character") + expect_type(vector_sql, "character") expect_false(any(duplicated(vector))) expect_true(all(!is.na(vector))) diff --git a/tests/testthat/test-list_deployment_ids.R b/tests/testthat/test-list_deployment_ids.R index ed16748e..3bd1abc9 100644 --- a/tests/testthat/test-list_deployment_ids.R +++ b/tests/testthat/test-list_deployment_ids.R @@ -1,11 +1,17 @@ -con <- connect_to_etn() - test_that("list_deployment_ids() returns unique list of values", { - vector <- list_deployment_ids(con) + vector <- list_deployment_ids() - expect_is(vector, "character") + expect_type(vector, "character") expect_false(any(duplicated(vector))) expect_true(all(!is.na(vector))) expect_true("1437" %in% vector) + + vector_sql <- list_deployment_ids(api = FALSE) + + expect_type(vector_sql, "character") + expect_false(any(duplicated(vector_sql))) + expect_true(all(!is.na(vector_sql))) + + expect_true("1437" %in% vector_sql) }) diff --git a/tests/testthat/test-list_receiver_ids.R b/tests/testthat/test-list_receiver_ids.R index ca6f766f..a02871e7 100644 --- a/tests/testthat/test-list_receiver_ids.R +++ b/tests/testthat/test-list_receiver_ids.R @@ -1,9 +1,7 @@ -con <- connect_to_etn() - test_that("list_receiver_ids() returns unique list of values", { - vector <- list_receiver_ids(con) + vector <- list_receiver_ids() - expect_is(vector, "character") + expect_type(vector, "character") expect_false(any(duplicated(vector))) expect_true(all(!is.na(vector))) diff --git a/tests/testthat/test-list_scientific_names.R b/tests/testthat/test-list_scientific_names.R index 18fd5a3c..1a22315f 100644 --- a/tests/testthat/test-list_scientific_names.R +++ b/tests/testthat/test-list_scientific_names.R @@ -1,9 +1,7 @@ -con <- connect_to_etn() - test_that("list_scientific_names() returns unique list of values", { - vector <- list_scientific_names(con) + vector <- list_scientific_names() - expect_is(vector, "character") + expect_type(vector, "character") expect_false(any(duplicated(vector))) expect_true(all(!is.na(vector))) diff --git a/tests/testthat/test-list_station_names.R b/tests/testthat/test-list_station_names.R index 2b87abf5..32f13f7d 100644 --- a/tests/testthat/test-list_station_names.R +++ b/tests/testthat/test-list_station_names.R @@ -1,9 +1,7 @@ -con <- connect_to_etn() - test_that("list_station_names() returns unique list of values", { - vector <- list_station_names(con) + vector <- list_station_names() - expect_is(vector, "character") + expect_type(vector, "character") expect_false(any(duplicated(vector))) expect_true(all(!is.na(vector))) diff --git a/tests/testthat/test-list_tag_serial_numbers.R b/tests/testthat/test-list_tag_serial_numbers.R index acf95155..44d30085 100644 --- a/tests/testthat/test-list_tag_serial_numbers.R +++ b/tests/testthat/test-list_tag_serial_numbers.R @@ -1,11 +1,17 @@ -con <- connect_to_etn() test_that("list_tag_serial_numbers() returns unique list of values", { - vector <- list_tag_serial_numbers(con) + vector <- list_tag_serial_numbers() - expect_is(vector, "character") + expect_type(vector, "character") expect_false(any(duplicated(vector))) expect_true(all(!is.na(vector))) expect_true("1187450" %in% vector) + + vector_sql <- list_tag_serial_numbers(api = FALSE) + expect_type(vector_sql, "character") + expect_false(any(duplicated(vector_sql))) + expect_true(all(!is.na(vector_sql))) + + expect_true("1187450" %in% vector_sql) }) diff --git a/tests/testthat/test-list_values.R b/tests/testthat/test-list_values.R index 637dd2cd..41690cc0 100644 --- a/tests/testthat/test-list_values.R +++ b/tests/testthat/test-list_values.R @@ -49,8 +49,8 @@ test_that("list_values() returns error for incorrect input", { test_that("list_values() returns a vector with unique values", { # Output has right class - expect_is(list_values(df, chr_col), class = "character") - expect_is(list_values(df, num_col), class = "numeric") + expect_type(list_values(df, chr_col), class = "character") + expect_type(list_values(df, num_col), class = "numeric") # Output value is correct with default split value (comma) expect_equal(list_values(df, chr_col), c("A", "B", "C", "D"))