From 5b2aa565c5f6fc4c42bd0ef06463c12d8496f96f Mon Sep 17 00:00:00 2001 From: Rolf Simoes Date: Tue, 6 Feb 2024 14:18:20 +0100 Subject: [PATCH] Improve static functions --- NAMESPACE | 4 ++++ R/static-funs.R | 50 +++++++++++++++++++++++++++++++++++++++---------- 2 files changed, 44 insertions(+), 10 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index c68d0a6f..175858eb 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -71,6 +71,8 @@ S3method(items_reap,doc_items) S3method(items_sign,default) S3method(items_sign,doc_item) S3method(items_sign,doc_items) +S3method(link_open,doc_link) +S3method(links,rstac_doc) S3method(parse_params,ext_filter) S3method(parse_params,ext_query) S3method(parse_params,items) @@ -86,6 +88,8 @@ S3method(print,doc_link) S3method(print,doc_links) S3method(print,doc_queryables) S3method(print,rstac_query) +S3method(read_collections,catalog) +S3method(read_items,doc_collection) S3method(stac_type,rstac_doc) S3method(stac_version,doc_collections) S3method(stac_version,doc_items) diff --git a/R/static-funs.R b/R/static-funs.R index 1f9d3dde..a3506fcb 100644 --- a/R/static-funs.R +++ b/R/static-funs.R @@ -105,6 +105,14 @@ read_stac <- function(url, ...) { #' #' @export read_items <- function(collection, limit = 100, page = 1, progress = TRUE) { + UseMethod("read_items", collection) +} + +#' @export +read_items.doc_collection <- function(collection, + limit = 100, + page = 1, + progress = TRUE) { check_collection(collection) rel <- NULL link_items <- links(collection, rel == "item") @@ -153,6 +161,14 @@ read_items <- function(collection, limit = 100, page = 1, progress = TRUE) { #' #' @export read_collections <- function(catalog, limit = 100, page = 1, progress = TRUE) { + UseMethod("read_collections", catalog) +} + +#' @export +read_collections.catalog <- function(catalog, + limit = 100, + page = 1, + progress = TRUE) { check_catalog(catalog) rel <- NULL link_collections <- links(catalog, rel == "child") @@ -200,13 +216,25 @@ read_collections <- function(catalog, limit = 100, page = 1, progress = TRUE) { #' #' @export links <- function(x, ...) { + UseMethod("links") +} + +#' @export +links.rstac_doc <- function(x, ...) { exprs <- unquote( expr = as.list(substitute(list(...), env = environment())[-1]), env = parent.frame() ) sel <- !logical(length(x$links)) for (expr in exprs) { - sel <- sel & map_lgl(x$links, function(x) eval(expr, envir = x)) + sel <- sel & map_lgl(x$links, function(x) { + tryCatch( + eval(expr, envir = x), + error = function(e) { + FALSE + } + ) + }) } structure(x$links[sel], class = c("doc_links", "list")) } @@ -215,15 +243,17 @@ links <- function(x, ...) { #' #' @export link_open <- function(link, base_url = NULL) { - if (is.list(link)) { - check_link(link) - url <- link$href - if (!is.null(base_url)) - url <- resolve_url(base_url, url) - else if ("rstac:base_url" %in% names(link)) - url <- resolve_url(link[["rstac:base_url"]], url) - } else if (is.character(link)) - url <- link + UseMethod("link_open", link) +} + +#' @export +link_open.doc_link <- function(link, base_url = NULL) { + check_link(link) + url <- link$href + if (!is.null(base_url)) + url <- resolve_url(base_url, url) + else if ("rstac:base_url" %in% names(link)) + url <- resolve_url(link[["rstac:base_url"]], url) content <- jsonlite::read_json(url) # create an rstac doc from content and return as_rstac_doc(content, base_url = url)