feat(get_hydrometrie_observations_tr): add option "entities"

Fix #10

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)

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)

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}
 }

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)

tests/testthat/test-get_hydrometrie_observations_tr.R

+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)))
+})
+