Merge pull request #181 from rolfsimoes/dev

Dev version 1.0.1

Author: rolfsimoes

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: rstac
 Title: Client Library for SpatioTemporal Asset Catalog
-Version: 1.0.0
+Version: 1.0.1
 Authors@R:
     c(person("Rolf", "Simoes",
              email = "rolfsimoes@gmail.com",
@@ -22,7 +22,7 @@ License: MIT + file LICENSE
 URL: https://brazil-data-cube.github.io/rstac/
 BugReports: https://github.com/brazil-data-cube/rstac/issues
 Encoding: UTF-8
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.3
 Depends:
     R (>= 3.5)
 Imports:
@@ -38,7 +38,14 @@ Imports:
 Suggests:
     lifecycle,
     testthat,
-    knitr
+    knitr,
+    tmap,
+    leaflet,
+    stars,
+    slider,
+    ggplot2,
+    purrr,
+    dplyr
 Collate:
     'cql2-expr-funs.R'
     'cql2-types.R'
@@ -54,6 +61,7 @@ Collate:
     'assets-funs.R'
     'check-utils.R'
     'conformance-query.R'
+    'collections-funs.R'
     'collections-query.R'
     'deprec-funs.R'
     'doc-funs.R'

NAMESPACE

@@ -174,6 +174,10 @@ export(assets_rename)
 export(assets_select)
 export(assets_url)
 export(collections)
+export(collections_fetch)
+export(collections_length)
+export(collections_matched)
+export(collections_next)
 export(conformance)
 export(cql2_bbox_as_geojson)
 export(cql2_date)

NEWS.md

@@ -1,3 +1,12 @@
+# rstac (development version)
+
+# rstac 1.0.1 (Released 2024-07-18)
+
+* Add support to `jpg` in `preview_plot()` function (#161)
+* Fix variable in filter expressions (non-standard evaluation) (#160)
+* Fix `limit` parameter as integer type in `stac_search()` and `items()`
+* Improve `items_reap()` documentation (#152)
+
 # rstac 1.0.0 (Released 2024-02-14)
 
 * Add support to static catalogs;

R/assets-funs.R

@@ -43,6 +43,9 @@
 #' @param progress    a `logical` indicating if a progress bar must be
 #' shown or not. Defaults to `TRUE`.
 #'
+#' @param use_gdal    a `logical` indicating if the file should be downloaded
+#' by GDAL instead httr package.
+#'
 #' @param download_fn a `function` to handle download of assets for
 #' each item to be downloaded. Using this function, you can change the
 #' hrefs for each asset, as well as the way download is done.
@@ -88,7 +91,10 @@
 #' Multiple expressions are combine with `AND` operator. Expressions can
 #' use `asset` helper functions (i.e. `asset_key()`, `asset_eo_bands()`,
 #' and `asset_raster_bands()`). Multiple expressions are combined with
-#' `AND` operator.
+#' `AND` operator. `assets_select()` uses non-standard evaluation to evaluate
+#' its expressions. That means users must escape any variable or call to
+#' be able to use them in the expressions. The escape is done by using
+#' `double-curly-braces`, i.e., `{{variable}}`.
 #'
 #' **WARNING:** Errors in the evaluation of expressions are
 #' considered as `FALSE`.
@@ -117,8 +123,8 @@
 #' @examples
 #' \dontrun{
 #'  # assets_download function
-#'  stac("https://brazildatacube.dpi.inpe.br/stac/") %>%
-#'    stac_search(collections = "CB4-16D-2",
+#'  stac("https://data.inpe.br/bdc/stac/v1/") %>%
+#'    stac_search(collections = "CBERS4-WFI-16D-2",
 #'                datetime = "2019-06-01/2019-08-01") %>%
 #'    stac_search() %>%
 #'    get_request() %>%
@@ -127,22 +133,26 @@
 #'
 #' \dontrun{
 #'  # assets_url function
-#'  stac_item <- stac("https://brazildatacube.dpi.inpe.br/stac/") %>%
-#'   stac_search(collections = "CB4-16D-2", limit = 100,
-#'          datetime = "2017-08-01/2018-03-01",
-#'          bbox = c(-48.206,-14.195,-45.067,-12.272)) %>%
-#'   get_request() %>% items_fetch(progress = FALSE)
+#'  stac_item <- stac("https://data.inpe.br/bdc/stac/v1/") %>%
+#'    stac_search(
+#'      collections = "CBERS4-WFI-16D-2",
+#'      limit = 100,
+#'      datetime = "2017-08-01/2018-03-01",
+#'      bbox = c(-48.206,-14.195,-45.067,-12.272)) %>%
+#'    get_request() %>% items_fetch(progress = FALSE)
 #'
 #'  stac_item %>% assets_url()
 #' }
 #'
 #' \dontrun{
 #'  # assets_select function
-#'  stac_item <- stac("https://brazildatacube.dpi.inpe.br/stac/") %>%
-#'   stac_search(collections = "CB4-16D-2", limit = 100,
-#'          datetime = "2017-08-01/2018-03-01",
-#'          bbox = c(-48.206,-14.195,-45.067,-12.272)) %>%
-#'   get_request() %>% items_fetch(progress = FALSE)
+#'  stac_item <- stac("https://data.inpe.br/bdc/stac/v1/") %>%
+#'    stac_search(
+#'      collections = "CBERS4-WFI-16D-2",
+#'      limit = 100,
+#'      datetime = "2017-08-01/2018-03-01",
+#'      bbox = c(-48.206,-14.195,-45.067,-12.272)) %>%
+#'    get_request() %>% items_fetch(progress = FALSE)
 #'
 #'  stac_item %>% assets_select(asset_names = "NDVI")
 #' }
@@ -182,6 +192,7 @@ assets_download <- function(items,
                             asset_names = NULL,
                             output_dir = getwd(),
                             overwrite = FALSE, ...,
+                            use_gdal = FALSE,
                             download_fn = NULL) {
   # check output dir
   if (!dir.exists(output_dir))
@@ -197,6 +208,7 @@ assets_download.doc_item <- function(items,
                                      asset_names = NULL,
                                      output_dir = getwd(),
                                      overwrite = FALSE, ...,
+                                     use_gdal = FALSE,
                                      create_json = FALSE,
                                      download_fn = NULL) {
   if (!is.null(asset_names)) {
@@ -209,7 +221,7 @@ assets_download.doc_item <- function(items,
   }
   items$assets <- lapply(
     items$assets, asset_download, output_dir = output_dir,
-    overwrite = overwrite, ..., download_fn = download_fn
+    overwrite = overwrite, use_gdal = use_gdal, download_fn = download_fn, ...
   )
   if (create_json) {
     file <- "item.json"
@@ -228,6 +240,7 @@ assets_download.doc_items <- function(items,
                                       asset_names = NULL,
                                       output_dir = getwd(),
                                       overwrite = FALSE, ...,
+                                      use_gdal = FALSE,
                                       download_fn = NULL,
                                       create_json = TRUE,
                                       items_max = Inf,
@@ -249,7 +262,7 @@ assets_download.doc_items <- function(items,
     items$features[[i]] <- assets_download(
       items = items$features[[i]], asset_names = asset_names,
       output_dir = output_dir, overwrite = overwrite,
-      create_json = FALSE, download_fn = download_fn, ...
+      use_gdal = use_gdal, create_json = FALSE, download_fn = download_fn, ...
     )
   }
   if (create_json)
@@ -336,10 +349,7 @@ assets_select <- function(items, ..., asset_names = NULL, select_fn = NULL) {
 assets_select.doc_item <- function(items, ...,
                                    asset_names = NULL,
                                    select_fn = NULL) {
-  exprs <- unquote(
-    expr = as.list(substitute(list(...), env = environment())[-1]),
-    env =  parent.frame()
-  )
+  exprs <- as.list(substitute(list(...), env = environment()))[-1]
   init_length <- length(items$assets)
   if (!is.null(asset_names)) {
     asset_names <- intersect(names(items$assets), asset_names)
@@ -348,9 +358,10 @@ assets_select.doc_item <- function(items, ...,
   if (length(exprs) > 0) {
     if (!is.null(names(exprs)))
       .error("Select expressions cannot be named.")
-    for (i in seq_along(exprs)) {
+    for (expr in exprs) {
+      expr <- unquote(expr = expr, env =  parent.frame())
       sel <- map_lgl(names(items$assets), function(key) {
-        select_eval(key = key, asset = items$assets[[key]], expr = exprs[[i]])
+        select_eval(key = key, asset = items$assets[[key]], expr = expr)
       })
       items$assets <- items$assets[sel]
     }

R/assets-utils.R

@@ -56,19 +56,36 @@ select_exec <- function(key, asset, select_fn) {
 asset_download <- function(asset,
                            output_dir,
                            overwrite, ...,
+                           use_gdal = FALSE,
                            download_fn = NULL) {
   if (!is.null(download_fn))
     return(download_fn(asset))
   # create a full path name
-  path <- url_get_path(asset$href)
-  out_file <- path_normalize(output_dir, path)
-  dir_create(out_file)
-  make_get_request(
-    url = asset$href,
-    httr::write_disk(path = out_file, overwrite = overwrite),
-    ...,
-    error_msg = "Error while downloading"
-  )
-  asset$href <- path
+  out_file <- path_normalize(output_dir, url_get_path(asset$href))
+  out_dir <- dirname(out_file)
+  if (!dir.exists(out_dir))
+    dir.create(out_dir, recursive = TRUE)
+  stopifnot(dir.exists(out_dir))
+  if (use_gdal) {
+    if (file.exists(out_file) && !overwrite)
+      .error("File already exists. Use `overwrite=TRUE`.")
+    if (file.exists(out_file))
+      unlink(out_file)
+    sf::gdal_utils(
+      util = "translate",
+      source = gdalvsi_append(asset$href),
+      destination = out_file, ...
+    )
+    if (!file.exists(out_file)) {
+      .error("Download failed. File: '%s'.", asset$href)
+    }
+  } else {
+    make_get_request(
+      url = asset$href,
+      httr::write_disk(path = out_file, overwrite = overwrite),
+      error_msg = "Error while downloading", ...
+    )
+  }
+  asset$href <- out_file
   asset
 }

R/check-utils.R

@@ -74,6 +74,14 @@ check_collection <- function(collection) {
   collection
 }
 
+check_collections <- function(collections) {
+  if (!is.list(collections) || is.null(names(collections)))
+    .error("Invalid doc_collections object.")
+  if (!"links" %in% names(collections))
+    .error("Invalid doc_collections object. Expecting `links` key.")
+  collections
+}
+
 check_character <- function(x, msg, ...) {
   if (!is.character(x))
     .error(msg, ...)