diff --git a/R/get_hydrometrie_observations_tr.R b/R/get_hydrometrie_observations_tr.R index 5b5f262de98a000ee2dc9555e3b5370b982cebbb..0cf9d4b29cd067bf4e560f0efa0763c8e1994f4c 100644 --- a/R/get_hydrometrie_observations_tr.R +++ b/R/get_hydrometrie_observations_tr.R @@ -3,6 +3,7 @@ #' See the API documentation for available filter parameters: \url{https://hubeau.eaufrance.fr/page/api-hydrometrie} #' #' @template param_get_common +#' @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. #' @export @@ -12,7 +13,8 @@ #' get_hydrometrie_observations_tr(list(code_entite = "H0203020", grandeur_hydro = "Q")) #' get_hydrometrie_observations_tr <- function(params, - cfg = config::get(file = system.file("config.yml", + entities = "station", + cfg = config::get(file = system.file("config.yml", package = "hubeau"))) { l <- doApiQuery( api = "hydrometrie", @@ -22,12 +24,18 @@ get_hydrometrie_observations_tr <- function(params, ) l <- lapply(l, function(x) { x$geometry <- NULL - if (is.null(x$code_station)) { - # See bug https://github.com/BRGM/hubeau/issues/73 - NULL - } else { - x + 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) diff --git a/R/get_niveaux_nappes_chroniques_tr.R b/R/get_niveaux_nappes_chroniques_tr.R index 390b70160a13a257b436cecc3958764f5299ceaa..633bcb5a1ebf5552a2f0b1ba6ab296ec4318cc21 100644 --- a/R/get_niveaux_nappes_chroniques_tr.R +++ b/R/get_niveaux_nappes_chroniques_tr.R @@ -8,7 +8,8 @@ #' @export #' #' @examples -#' # For retrieving the last real time observed piezometric level at station 'BSS001VZGZ' (new BSS identifier) +#' # For retrieving the last real time observed piezometric level +#' # at station 'BSS001VZGZ' (new BSS identifier) #' df <- get_niveaux_nappes_chroniques_tr(list(bss_id = "BSS001VZGZ")) #' #' # Plot the water elevation (NGF) diff --git a/man/get_hydrometrie_observations_tr.Rd b/man/get_hydrometrie_observations_tr.Rd index 03509ebcc7355380b85db08d3fe45d37855023c7..32e21a846a33201e566413a82cf6994982e4f888 100644 --- a/man/get_hydrometrie_observations_tr.Rd +++ b/man/get_hydrometrie_observations_tr.Rd @@ -6,12 +6,15 @@ \usage{ get_hydrometrie_observations_tr( params, + entities = "station", cfg = config::get(file = system.file("config.yml", package = "hubeau")) ) } \arguments{ \item{params}{a \link{list} the list of parameters of the queries and their values in the format \code{list(ParamName = "Param value", ...)}, use the function \link{get_available_params} for a list of the available parameters for a given operation in an API and see the API documentation for the complete list of available filter parameters} +\item{entities}{1-\link{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} + \item{cfg}{a \link{config} object Configuration of the communication. Use by default the internal package configuration} } diff --git a/man/get_niveaux_nappes_chroniques_tr.Rd b/man/get_niveaux_nappes_chroniques_tr.Rd index 19627fd5a6883e74c68e779d792b2bb1765c5ec0..904f4e9eb08188772eaac619bebac8480c218dba 100644 --- a/man/get_niveaux_nappes_chroniques_tr.Rd +++ b/man/get_niveaux_nappes_chroniques_tr.Rd @@ -22,7 +22,8 @@ a \link[tibble:tibble]{tibble::tibble} with all available parameters in columns See the API documentation for available filter parameters: \url{https://hubeau.eaufrance.fr/page/api-piezometrie} } \examples{ -# For retrieving the last real time observed piezometric level at station 'BSS001VZGZ' (new BSS identifier) +# For retrieving the last real time observed piezometric level +# at station 'BSS001VZGZ' (new BSS identifier) df <- get_niveaux_nappes_chroniques_tr(list(bss_id = "BSS001VZGZ")) # Plot the water elevation (NGF) diff --git a/tests/testthat/test-get_hydrometrie_observations_tr.R b/tests/testthat/test-get_hydrometrie_observations_tr.R new file mode 100644 index 0000000000000000000000000000000000000000..cd874a00eb04c5fbceb7c92ecf292ed56547a9cd --- /dev/null +++ b/tests/testthat/test-get_hydrometrie_observations_tr.R @@ -0,0 +1,24 @@ +params <- list(code_entite = "H0203020", + date_debut_obs = format(Sys.Date()-3), + grandeur_hydro = "Q") + +test_that("entities not in ('station', 'site', 'both') should throw an error", { + expect_error( + df <- get_hydrometrie_observations_tr(params, entities = "wrong value"), + regexp = "must be one of these values" + ) +}) + + +test_that("`entities = 'station'` => 'code_station' must be always not NA", { + skip_on_cran() + df <- get_hydrometrie_observations_tr(params, entities = "station") + expect_true(all(!is.na(df$code_station))) +}) + +test_that("`entities = 'site'` => 'code_station' must be always NA", { + skip_on_cran() + df <- get_hydrometrie_observations_tr(params, entities = "site") + expect_true(all(is.na(df$code_station))) +}) +