316 use etnservice as a dependency and drop sql helpers

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: etn
 Title: Access Data from the European Tracking Network
-Version: 2.3.0
+Version: 2.2.1.9000
 Authors@R: c(
     person("Peter", "Desmet", email = "[email protected]",
            role = c("aut", "cre"), comment =  c(ORCID = "0000-0002-8442-8025")),
@@ -23,18 +23,16 @@ Depends:
 Imports:
     askpass,
     assertthat,
-    DBI,
     dplyr,
+    etnservice,
     glue,
     httr,
-    jsonlite,
     lifecycle,
-    lubridate,
     methods,
-    odbc,
     readr,
     rlang,
-    stringr
+    stringr,
+    utils
 Suggests:
     formattable,
     leaflet,

NEWS.md

@@ -5,3 +5,4 @@
 * `connect_to_etn()` is no longer necessary and therefore deprecated. All functions will create their own connection when used. If you have no credentials stored in the system environment, the functions will require you to enter them once per session (#303).
 * The deprecated functions `get_deployments()`, `get_detections()`, `get_projects()`, `get_receivers()`, `list_network_project_codes()` are no longer included.
 * `write_dwc()` now invisibly returns the transformed data as a list of data frames (rather than a data frame) (#302).
+* Queries via the API and on the Lifewatch RStudio Server will now always return the same results.

R/conduct_parent_to_helpers.R

@@ -0,0 +1,55 @@
+#' 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?
+#' @param ignored_arguments Character vector of arguments not to pass to the API
+#'   or SQL helper
+#' @param ... options on how to fetch the response. Forwarded to
+#'   `forward_to_api()`
+#'
+#' @return parsed R object as resulting from the API
+#'
+#' @family helper functions
+#' @noRd
+conduct_parent_to_helpers <- function(api,
+                                      ignored_arguments = NULL,
+                                      ...) {
+  # Check arguments
+  assertthat::assert_that(assertthat::is.flag(api))
+  assertthat::assert_that(is.character(ignored_arguments) |
+                            is.null(ignored_arguments))
+
+  # 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",
+        ignored_arguments,
+        "function_identity"
+      )
+    ]
+
+  if (api) {
+    out <- do.call(
+      forward_to_api,
+      list(function_identity = function_identity,
+           payload = arguments_to_pass,
+           ...)
+    )
+  } else {
+    out <- do.call(utils::getFromNamespace(function_identity, ns = "etnservice"),
+                   args = append(arguments_to_pass,
+                                 list(credentials = get_credentials()),
+                                 after = 0)
+    )
+  }
+
+  return(out)
+}

R/get_acoustic_deployments.R

@@ -53,171 +53,3 @@ get_acoustic_deployments <- function(connection,
   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 <- create_connection(credentials = get_credentials())
-
-  # Check connection
-  check_connection(connection)
-
-  # Check deployment_id
-  if (is.null(deployment_id)) {
-    deployment_id_query <- "True"
-  } else {
-    deployment_id <- check_value(
-      deployment_id,
-      list_deployment_ids(api = FALSE),
-      "receiver_id"
-    )
-    deployment_id_query <- glue::glue_sql(
-      "dep.id_pk IN ({deployment_id*})",
-      .con = connection
-    )
-  }
-
-  # Check receiver_id
-  if (is.null(receiver_id)) {
-    receiver_id_query <- "True"
-  } else {
-    receiver_id <- check_value(
-      receiver_id,
-      list_receiver_ids(api = FALSE),
-      "receiver_id"
-    )
-    receiver_id_query <- glue::glue_sql(
-      "receiver.receiver IN ({receiver_id*})",
-      .con = connection
-    )
-  }
-
-  # Check acoustic_project_code
-  if (is.null(acoustic_project_code)) {
-    acoustic_project_code_query <- "True"
-  } else {
-    acoustic_project_code <- check_value(
-      acoustic_project_code,
-      list_acoustic_project_codes(api = FALSE),
-      "acoustic_project_code",
-      lowercase = TRUE
-    )
-    acoustic_project_code_query <- glue::glue_sql(
-      "LOWER(network_project.projectcode) IN ({acoustic_project_code*})",
-      .con = connection
-    )
-  }
-
-  # Check station_name
-  if (is.null(station_name)) {
-    station_name_query <- "True"
-  } else {
-    station_name <- check_value(
-      station_name,
-      list_station_names(api = FALSE),
-      "station_name"
-    )
-    station_name_query <- glue::glue_sql(
-      "dep.station_name IN ({station_name*})",
-      .con = connection
-    )
-  }
-
-  # Build query
-  query <- glue::glue_sql("
-    SELECT
-      dep.id_pk AS deployment_id,
-      receiver.receiver AS receiver_id,
-      network_project.projectcode AS acoustic_project_code,
-      dep.station_name AS station_name,
-      location_name AS station_description,
-      location_manager AS station_manager,
-      dep.deploy_date_time AS deploy_date_time,
-      dep.deploy_lat AS deploy_latitude,
-      dep.deploy_long AS deploy_longitude,
-      dep.intended_lat AS intended_latitude,
-      dep.intended_long AS intended_longitude,
-      dep.mooring_type AS mooring_type,
-      dep.bottom_depth AS bottom_depth,
-      dep.riser_length AS riser_length,
-      dep.instrument_depth AS deploy_depth,
-      dep.battery_install_date AS battery_installation_date,
-      dep.drop_dead_date AS battery_estimated_end_date,
-      dep.activation_datetime AS activation_date_time,
-      dep.recover_date_time AS recover_date_time,
-      dep.recover_lat AS recover_latitude,
-      dep.recover_long AS recover_longitude,
-      dep.download_date_time AS download_date_time,
-      dep.data_downloaded AS download_file_name,
-      dep.valid_data_until_datetime AS valid_data_until_date_time,
-      dep.sync_date_time AS sync_date_time,
-      dep.time_drift AS time_drift,
-      dep.ar_battery_install_date AS ar_battery_installation_date,
-      dep.ar_confirm AS ar_confirm,
-      dep.transmit_profile AS transmit_profile,
-      dep.transmit_power_output AS transmit_power_output,
-      dep.log_temperature_stats_period AS log_temperature_stats_period,
-      dep.log_temperature_sample_period AS log_temperature_sample_period,
-      dep.log_tilt_sample_period AS log_tilt_sample_period,
-      dep.log_noise_stats_period AS log_noise_stats_period,
-      dep.log_noise_sample_period AS log_noise_sample_period,
-      dep.log_depth_stats_period AS log_depth_stats_period,
-      dep.log_depth_sample_period AS log_depth_sample_period,
-      dep.comments AS comments
-      -- dep.project: dep.project_fk instead
-      -- dep.check_complete_time
-      -- dep.voltage_at_deploy
-      -- dep.voltage_at_download
-      -- dep.location_description
-      -- dep.date_created
-      -- dep.date_modified
-      -- dep.distance_to_mouth
-      -- dep.source
-      -- dep.acousticreleasenumber: cpod
-      -- dep.hydrophonecablelength: cpod
-      -- dep.recordingname: cpod
-      -- dep.hydrophonesensitivity: cpod
-      -- dep.amplifiersensitivity: cpod
-      -- dep.sample_rate: cpod
-      -- dep.external_id
-    FROM
-      acoustic.deployments AS dep
-      LEFT JOIN acoustic.receivers AS receiver
-        ON dep.receiver_fk = receiver.id_pk
-      LEFT JOIN common.projects AS network_project
-        ON dep.project_fk = network_project.id
-    WHERE
-      dep.deployment_type = 'acoustic_telemetry'
-      AND {deployment_id_query}
-      AND {receiver_id_query}
-      AND {acoustic_project_code_query}
-      AND {station_name_query}
-    ", .con = connection)
-  deployments <- DBI::dbGetQuery(connection, query)
-
-  # Filter on open deployments
-  if (open_only) {
-    deployments <- filter(deployments, is.na(.data$recover_date_time))
-  }
-
-  # Sort data
-  deployments <-
-    deployments %>%
-    dplyr::arrange(
-      .data$acoustic_project_code,
-      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)
-}