From ead2b9b5c01b4d5eafa6f8ea225daf8d3b4445d9 Mon Sep 17 00:00:00 2001
From: Dorchies David <david.dorchies@irstea.fr>
Date: Mon, 27 Sep 2021 13:31:47 +0200
Subject: [PATCH] fix(get_hydrometrie_observations_tr): Error on empty response
Fix #13
---
R/doApiQuery.R | 4 +-
R/get_hydrometrie_observations_tr.R | 40 +++++++++++--------
.../test-get_hydrometrie_observations_tr.R | 3 +-
3 files changed, 28 insertions(+), 19 deletions(-)
diff --git a/R/doApiQuery.R b/R/doApiQuery.R
index d3f58ae..93b4ed0 100644
--- a/R/doApiQuery.R
+++ b/R/doApiQuery.R
@@ -88,8 +88,10 @@ doApiQuery <- function(api,
if (as.numeric(l$count) > 20000) {
stop(
"The request reach the API limitation of 20000 records.\n",
- "Use filter arguments to reduce the number of records of your request."
+ "Use filter arguments to reduce the number of records of your query."
)
+ } else if(as.numeric(l$count) == 0) {
+ return(NULL)
}
data <- c(data, l$data)
if (resp$status_code == 206) {
diff --git a/R/get_hydrometrie_observations_tr.R b/R/get_hydrometrie_observations_tr.R
index 0cf9d4b..8d6e467 100644
--- a/R/get_hydrometrie_observations_tr.R
+++ b/R/get_hydrometrie_observations_tr.R
@@ -6,6 +6,8 @@
#' @param entities 1-[character] string filtering the rows of the returned value, possible values are: "station" for filtering on station rows, "site" for filtering on site rows, "both" for keeping all the rows
#'
#' @return a [tibble::tibble] with all available parameters in columns and one row by time step and by station.
+#' If the query returns no records then the returned value is [NULL].
+#'
#' @export
#'
#' @examples
@@ -16,27 +18,33 @@ get_hydrometrie_observations_tr <- function(params,
entities = "station",
cfg = config::get(file = system.file("config.yml",
package = "hubeau"))) {
+ # Checks
+ if(!entities %in% c("station", "site", "both")) {
+ stop("Argument 'entities' must be one of these values: 'station', 'site', 'both'")
+ }
+
l <- doApiQuery(
api = "hydrometrie",
operation = "observations_tr",
params = params,
cfg = cfg
)
- l <- lapply(l, function(x) {
- x$geometry <- NULL
- if (entities == "station") {
- if (is.null(x$code_station)) {
- return(NULL)
- }
- } else if (entities == "site") {
- if (!is.null(x$code_station)) {
- return(NULL)
+ if(!is.null(l)) {
+ l <- lapply(l, function(x) {
+ x$geometry <- NULL
+ if (entities == "station") {
+ if (is.null(x$code_station)) {
+ return(NULL)
+ }
+ } else if (entities == "site") {
+ if (!is.null(x$code_station)) {
+ return(NULL)
+ }
}
- } else if (entities != "both") {
- stop("Argument 'entities' must be one of these values: 'station', 'site', 'both'")
- }
- return(x)
- })
- l[sapply(l, is.null)] <- NULL
- convert_list_to_tibble(l)
+ return(x)
+ })
+ l[sapply(l, is.null)] <- NULL
+ l <- convert_list_to_tibble(l)
+ }
+ return(l)
}
diff --git a/tests/testthat/test-get_hydrometrie_observations_tr.R b/tests/testthat/test-get_hydrometrie_observations_tr.R
index cd874a0..cc57a11 100644
--- a/tests/testthat/test-get_hydrometrie_observations_tr.R
+++ b/tests/testthat/test-get_hydrometrie_observations_tr.R
@@ -1,4 +1,4 @@
-params <- list(code_entite = "H0203020",
+params <- list(bbox = "1.6,47.79,1.8,47.99",
date_debut_obs = format(Sys.Date()-3),
grandeur_hydro = "Q")
@@ -9,7 +9,6 @@ test_that("entities not in ('station', 'site', 'both') should throw an error", {
)
})
-
test_that("`entities = 'station'` => 'code_station' must be always not NA", {
skip_on_cran()
df <- get_hydrometrie_observations_tr(params, entities = "station")
--
GitLab