Merge pull request #275 from R-ArcGIS/arc-open-refactor

rewrite arc_open to support item id's or portal urls

Author: JosiahParry

DESCRIPTION

@@ -22,7 +22,7 @@ License: Apache License (>= 2)
 Encoding: UTF-8
 LazyData: true
 Imports: 
-    arcgisutils (>= 0.2.0),
+    arcgisutils (>= 0.3.3.9000),
     arcpbf (>= 0.1.5),
     cli,
     httr2 (>= 1.0.5),
@@ -34,7 +34,7 @@ Imports:
     terra,
     utils
 Depends: 
-    R (>= 4.1.0)
+    R (>= 4.2.0)
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.3.2
 Suggests: 

NEWS.md

@@ -4,10 +4,11 @@
 
 - `update_features()` is now parallelized and sends updates in chunks see `chunk_size` argument and `progress` arguments. The return type is now a `data.frame` and not a list with `updateResults`
 - `delete_features()` is now parallelized and deletes in chunks. See above. 
-- `{arcgislayers}` now depends on R 4.1 or higher.
+- `{arcgislayers}` now depends on R 4.2 or higher.
 
 ## New features
 
+- `arc_open()` now works with item IDs or a variety of URLs such as item, user, group, and more <https://github.com/R-ArcGIS/arcgislayers/pull/275>
 - `add_definition()` (#178), `update_definition()` (#127), and `delete_definition()` functions for FeatureServer and FeatureLayer objects.
 
 ## Bug Fixes

R/arc-open.R

@@ -9,14 +9,18 @@
 #'  `r lifecycle::badge("experimental")`
 #'
 #' @param url The url of the remote resource. Must be of length one.
-#' @param token your authorization token.
+#' @inheritParams arcgisutils::arc_item
 #'
 #' @seealso arc_select arc_raster
 #' @export
 #' @returns
-#' Depending on the provided URL returns a `FeatureLayer`, `Table`, `FeatureServer`, `ImageServer`, or `MapServer`. Each of these objects is a named list containing the properties of the service.
+#' Depending on item ID or URL returns a `PortalItem`, `FeatureLayer`, `Table`, `FeatureServer`, `ImageServer`, or `MapServer`, `GeocodeServer`, among other. Each of these objects is a named list containing the properties of the service.
 #' @examples
 #' \dontrun{
+#'
+#' # FeatureServer ID
+#' arc_open("3b7221d4e47740cab9235b839fa55cd7")
+#'
 #' # FeatureLayer
 #' furl <- paste0(
 #'   "https://services3.arcgis.com/ZvidGQkLaDJxRSJ2/arcgis/rest/services/",
@@ -54,64 +58,124 @@
 #'
 #' arc_open(map_url)
 #' }
-arc_open <- function(url, token = arc_token()) {
-  check_url(url)
+arc_open <- function(url, host = arc_host(), token = arc_token()) {
+  check_string(url, allow_empty = FALSE)
 
-  # parse url query and strip from url if query matches default
-  query <- parse_url_query(url) %||% list()
-  url <- clear_url_query(url)
-
-  # extract layer metadata
-  meta <- fetch_layer_metadata(url, token)
+  if (!is_url(url)) {
+    e_msg <- "Expected an item ID or url to a portal item."
 
-  # set url for later use
-  meta[["url"]] <- url
+    item <- rlang::try_fetch(
+      arc_item(url, host, token),
+      error = function(cnd) cli::cli_abort(e_msg, call = rlang::caller_call(2))
+    )
 
-  # layer class
-  layer_class <- gsub("\\s", "", meta[["type"]])
+    if (is.null(item$url)) {
+      # return a portal item if the url is null
+      return(item)
+    }
 
-  # if it's missing it means it's a server type. Need to deduce.
-  if (length(layer_class) == 0) {
-    if (any(grepl("pixel|band|raster", names(meta)))) {
-      layer_class <- "ImageServer"
-    } else if (grepl("MapServer", meta[["url"]])) {
-      layer_class <- "MapServer"
-    } else if (
-      "layers" %in% names(meta) || grepl("FeatureServer", meta[["url"]])
-    ) {
-      layer_class <- "FeatureServer"
-    } else {
-      return(meta)
+    # return the portal item if the url type is null
+    if (is.null(arc_url_type(item$url))) {
+      return(item)
     }
+
+    # otherwise we fetch the url from the new item
+    url <- item$url
   }
 
-  # construct the appropriate class based on the resultant `layer_class`
-  res <- switch(
-    layer_class,
-    "FeatureLayer" = structure(
-      meta,
-      class = layer_class,
-      query = query
-    ),
-    "Table" = structure(
-      meta,
-      class = layer_class,
-      query = query
+  # parse the provided url
+  info <- arc_url_parse(url)
+
+  if (is.null(info$type)) {
+    cli::cli_abort(
+      c(
+        "!" = "Unable to open the provided url or item ID.",
+        "i" = "If you think this an error, please create an issue:",
+        "{.url https://github.com/r-arcgis/arcgislayers/issues/new}"
+      )
+    )
+  }
+
+  switch(
+    info$type,
+    "FeatureServer" = {
+      as_layer_class(clear_url_query(url), token, info$type)
+    },
+    "MapServer" = as_layer_class(
+      clear_url_query(url),
+      token,
+      info$type
     ),
-    "FeatureServer" = structure(
-      meta,
-      class = layer_class
+    "ImageServer" = as_layer_class(
+      clear_url_query(url),
+      token,
+      info$type
     ),
-    "ImageServer" = structure(meta, class = layer_class),
-    "MapServer" = structure(meta, class = layer_class),
-    "GroupLayer" = structure(meta, class = layer_class),
+    "SceneServer" = as_layer_class(url, token, info$type),
+    "GeocodeServer" = as_layer_class(url, token, info$type),
+    # FIXME, unclear how to use this...
+    "GeometryServer" = as_layer_class(url, token, info$type),
+    # FIXME, unclear how to use this...
+    "GPServer" = as_layer_class(url, token, info$type),
+    "item" = {
+      # if we have an item url, we fetch the item
+      item <- arc_item(info$query$id, host = host, token = token)
+
+      # if there is no associated url we return the item
+      if (is.null(item[["url"]])) {
+        return(item)
+      }
+
+      url_type <- arc_url_type(item[["url"]])
+
+      if (is.null(url_type)) {
+        return(item)
+      }
+
+      # if there is a URL we're going to recurse
+      arc_open(item[["url"]], host = host, token = token)
+    },
+    "user" = arc_user(info$query$user, host = host, token = token),
+    "group" = arc_group(info$query$id, host = host, token = token),
+    "webscene" = arc_item(info$query$webscene, host = host, token = token),
+    "app" = arc_item(info$query$appid, host = host, token = token),
+    "notebook" = arc_item(info$query$id, host = host, token = token),
+    "experience" = {
+      path_components <- strsplit(info$path, "/")[[1]]
+      exp_id <- path_components[which(path_components == "experience") + 1]
+      arc_item(exp_id, host = host, token = token)
+    },
+    "storymap" = {
+      path_components <- strsplit(info$path, "/")[[1]]
+      sm_id <- path_components[which(path_components == "stories") + 1]
+      arc_item(sm_id, host = host, token = token)
+    },
+    "dashboard" = {
+      path_components <- strsplit(info$path, "/")[[1]]
+      db_id <- path_components[which(path_components == "dashboards") + 1]
+      arc_item(db_id, host = host, token = token)
+    },
+    "datapipeline" = arc_item(info$query$item, host = host, token = token),
+    "webapp" = arc_item(info$query$id, host = host, token = token),
     cli::cli_abort(
       c(
-        "Service type {.val {layer_class}} is not supported.",
+        "Service type {.val {info$type}} is not supported at this time.",
         "i" = "Please report this at {.url https://github.com/R-ArcGIS/arcgislayers/issues}"
       )
     )
   )
+}
+
+#' Fetch metadata and an appropriate class
+#' @noRd
+as_layer_class <- function(url, token, class = NULL) {
+  meta <- fetch_layer_metadata(url, token)
+  meta[["url"]] <- url
+  cls <- if (is.null(meta[["type"]])) {
+    NULL
+  } else {
+    gsub("\\s+", "", meta[["type"]])
+  }
 
-  res
+  structure(meta, class = c(cls %||% class, "list"))
 }

R/print-methods.R

@@ -121,7 +121,7 @@ print.FeatureServer <- function(x, n, ...) {
 
   header <- sprintf(
     "<%s <%s, %s>>",
-    class(x),
+    class(x)[1],
     fts_lbl,
     tbls_lbl
   )
@@ -197,7 +197,7 @@ print.MapServer <- function(x, ...) print.FeatureServer(x, ...)
 print.ImageServer <- function(x, ...) {
   header <- sprintf(
     "<%s <%i bands, %i fields>>",
-    class(x),
+    class(x)[1],
     x$bandCount,
     length(x$fields$name) %||% 0
   )

R/utils.R

@@ -134,24 +134,6 @@ coalesce_crs <- function(x, y) {
   }
 }
 
-#' Does x match the pattern of a URL?
-#' @noRd
-is_url <- function(x, pattern = NULL, ...) {
-  if (
-    !rlang::is_vector(x) || rlang::is_empty(x) || !rlang::is_scalar_character(x)
-  ) {
-    return(FALSE)
-  }
-
-  url_pattern <-
-    "http[s]?://(?:[[:alnum:]]|[$-_@.&+]|[!*\\(\\),]|(?:%[0-9a-fA-F][0-9a-fA-F]))+"
-
-  if (is.null(pattern)) {
-    return(grepl(url_pattern, x, ...))
-  }
-
-  grepl(url_pattern, x, ...) & grepl(pattern, x, ...)
-}
 
 #' Check if x is a valid URL
 #' @noRd

dev/downloads.R

@@ -2,7 +2,7 @@ library(dplyr)
 library(ggplot2)
 
 downloads <- cranlogs::cran_downloads(
-  c("arcgislayers", "arcgisutils", "arcpbf", "arcgisgeocode", "arcgisplaces"),
+  c("arcgislayers", "arcgisgeocode", "arcgisplaces", "calcite"),
   from = "2024-01-11",
   to = Sys.Date()
 ) |>
@@ -19,8 +19,21 @@ downloads <- cranlogs::cran_downloads(
 
 ggplot(downloads) +
   geom_line(aes(week_of, total_downloads)) +
-  facet_wrap("package", scales = "free", ncol = 2)
+  facet_wrap("package", scales = "free_y", ncol = 2) +
+  labs(y = "Cumulative downloads", x = "")
 
 downloads |>
   summarise(downloads = sum(downloads), .by = package) |>
   arrange(desc(downloads))
+
+
+weekly <- cranlogs::cran_downloads(
+  c("arcgislayers", "arcgisgeocode", "arcgisplaces", "calcite"),
+  from = "2024-01-11",
+  to = Sys.Date()
+) |>
+  as_tibble() |>
+  filter(count > 0) |>
+  mutate(week_of = lubridate::floor_date(date, "week")) |>
+  group_by(package, week_of) |>
+  summarise(total = sum(count))