Add input check functions using cli

Adds helper functions for input checks for arc_open, add_features, update_features, and add_item: - check_dataframe - check_url (w/ is_url) - check_string - check_crs_match - check_add_item_args Also adds inform_nin_feature to reduce duplicate between add_features and update_features
R-ArcGIS · Feb 18, 2024 · 9124eb3 · 9124eb3
1 parent f222684
commit 9124eb3
Show file tree

Hide file tree

Showing 4 changed files with 244 additions and 73 deletions.
diff --git a/R/add_item.R b/R/add_item.R
@@ -81,48 +81,39 @@ add_item <- function(
   # fetch the host from the token
   host <- token[["arcgis_host"]]
 
-  # if async = TRUE stop
-  # type must be feature service right now
-  # TODO make this cli_abort()
-  stopifnot(
-    "`async` must be `FALSE`" = !async,
-    "`type` must be `\"Feature Service\"`" = identical(type, "Feature Service")
+  check_add_item_args(
+    description = description,
+    snippet = snippet,
+    async = async,
+    type = type
   )
 
   # if CRS is missing require user input if interactive
   if (interactive() && is.na(sf::st_crs(x)) && inherits(x, "sf")) {
-    choice <- utils::menu(
-      c("Yes", "No"),
-      title = "CRS is missing from `x`. Continue?"
+    cli::cli_bullets(
+      c("!" = "{.arg x} has no CRS",
+        "*" = "Do you want to continue?"
+      )
     )
 
-    if (choice == 2L) {
-      # TODO cli_abort
-      stop("Aborting. CRS is missing.")
-    } else {
-      # TODO cli_warn
-      warning("Set the CRS to prevent this interruption.\n  - use `sf::st_set_crs()`")
+    choice <- readline(paste0("? (Y/n) "))
+
+    if (choice %in% c("n", "N", "no", "0")) {
+      cli::cli_abort("Aborting.")
     }
+
+    cli::cli_warn(
+      c("{.arg x} has no CRS.",
+        "*" = "Set CRS with {.fn sf::st_set_crs}")
+    )
+
   } else if (!interactive() && is.na(sf::st_crs(x))) {
-    # TODO cli_warn
-    warning(
-      "CRS is missing from `x`\nAssuming EPSG:3857."
+    cli::cli_warn(
+      c("CRS is missing from {.arg x}",
+        "i" = "Using {.val EPSG:3857}")
     )
   }
 
-  # check if snippet is too long
-  # TODO cli_warn
-  if (nchar(snippet) > 2048) warning("Snippet must be 2048 or fewer characters.")
-
-  # check if description is too big or too many eles
-  descrip_kb <- as.numeric(utils::object.size(description)) / 1000
-
-  # TODO cli_abort
-  stopifnot(
-    "`description` must be smaller than 64kb" = descrip_kb <= 64,
-    "`description` must be length 1" = length(description) == 1
-  )
-
   req_url <- paste0(host, "/sharing/rest/content/users/", user, "/addItem")
 
   # create the feature collection json
@@ -167,6 +158,50 @@ add_item <- function(
   data.frame(parsed)
 }
 
+#' @noRd
+check_add_item_args <- function(
+    description = "",
+    snippet = "",
+    async = FALSE,
+    type = "Feature Service",
+    call = rlang::caller_env()) {
+
+  # if async = TRUE stop
+  if (async) {
+    cli::cli_abort(
+      "{.arg async} must be {.val FALSE}",
+      call = call
+    )
+  }
+
+  # type must be feature service right now
+  if (!identical(type, "Feature Service")) {
+    check_string(type, call = call)
+    cli::cli_abort(
+      "{.arg type} must be {.str Feature Service}",
+      call = call
+    )
+  }
+
+  # TODO Check if snippet is allowed as a NULL input
+  check_string(snippet, call = call)
+
+  # check if snippet is too long
+  if (nchar(snippet) > 2048) {
+    # TODO If snippet *must* be 2048 or fewer characters this should be an error
+    cli::cli_warn("{.arg snippet} must be 2048 or fewer characters.")
+  }
+
+  check_string(description, call = call)
+  # check if description is too big or too many eles
+  descrip_kb <- as.numeric(utils::object.size(description)) / 1000
+
+  if (descrip_kb > 64) {
+    cli::cli_abort(
+      "{.arg description} must be smaller than 64kb"
+    )
+  }
+}
 
 
 #' @export

diff --git a/R/arc-add-update-delete.R b/R/arc-add-update-delete.R
@@ -60,7 +60,7 @@ add_features <- function(
   # initial check for type of `x`
   obj_check_layer(x)
 
-  stopifnot("`.data` must be a data.frame-type class" = inherits(.data, "data.frame"))
+  check_dataframe(.data)
 
   match_on <- match.arg(match_on)
 
@@ -71,21 +71,7 @@ add_features <- function(
   # TODO address data.frame objects / table layers
   # TODO error on list columns
 
-  target_crs <- sf::st_crs(x)
-  provided_crs <- sf::st_crs(.data)
-
-  # see commentary in `update_features.R`
-  if (!target_crs == provided_crs) {
-    if (is.na(sf::st_crs(.data))) {
-      warning("CRS missing from `.data` assuming ", sf::st_crs(x)$srid)
-    } else if (is.na(sf::st_crs(x))) {
-      warning("CRS missing from `x` cannot verify matching CRS.")
-    } else {
-      stop("`FeatureLayer` and `.data` have different CRS\nTranform to the same CRS:\n",
-           "  `sf::st_transform(.data, sf::st_crs(x))`")
-    }
-  }
-
+  check_crs_match(x, .data)
 
   # not that addFeatures does not update layer definitions so if any attributes
   # are provided that aren't in the feature layer, they will be ignored
@@ -110,15 +96,10 @@ add_features <- function(
     colnames(.data) <- cnames
   }
 
-  # columns not in the feature layer
-  nin_feature <- setdiff(cnames[!present_index], geo_col)
-
-  if (length(nin_feature) > 0 ) {
-    message(
-      "Columns in `.data` not in feature(s): ",
-      ifelse(length(nin_feature) > 1, paste0(nin_feature, collapse = ", "), nin_feature)
-    )
-  }
+  inform_nin_feature(
+    # columns not in the feature layer
+    setdiff(cnames[!present_index], geo_col)
+  )
 
   # subset accordingly
   .data <- .data[, present_index]
@@ -204,10 +185,17 @@ update_features <- function(
   if (!identical(sf::st_crs(x), sf::st_crs(.data))) {
 
     if (is.na(sf::st_crs(.data)) && inherits(.data, "sf")) {
-      warning("CRS missing from `.data` assuming ", sf::st_crs(x)$srid)
-    } else if (inherits(.data, "sf")){
-      stop("`FeatureLayer` and `.data` have different CRS\nTranform to the same CRS:\n",
-           "  `sf::st_transform(.data, sf::st_crs(x))`")
+      cli::cli_warn(
+        c("{.arg data} is missing a CRS",
+          "i" = paste0("Setting CRS to ", sf::st_crs(x)$srid)
+        ))
+    } else if (inherits(.data, "sf")) {
+      cli::cli_abort(
+        c("{.arg x} and {.arg .data} must share the same CRS",
+          "*" = "Tranform {.arg .data} to the same CRS as {.arg x} with
+          {.fn sf::st_transform}"
+        )
+      )
     }
   }  # not that addFeatures does not update layer definitions so if any attributes
   # are provided that aren't in the feature layer, they will be ignored
@@ -232,15 +220,10 @@ update_features <- function(
     colnames(.data) <- cnames
   }
 
-  # columns not in the feature layer
-  nin_feature <- setdiff(cnames[!present_index], geo_col)
-
-  if (length(nin_feature) > 0 ) {
-    message(
-      "Columns in `.data` not in feature(s): ",
-      ifelse(length(nin_feature) > 1, paste0(nin_feature, collapse = ", "), nin_feature)
-    )
-  }
+  inform_nin_feature(
+    # columns not in the feature layer
+    setdiff(cnames[!present_index], geo_col)
+  )
 
   # subset accordingly
   .data <- .data[, present_index]
@@ -261,6 +244,24 @@ update_features <- function(
   RcppSimdJson::fparse(httr2::resp_body_string(resp))
 }
 
+#' @noRd
+inform_nin_feature <- function(nin_feature) {
+  if (length(nin_feature) == 0) {
+    return(invisible(NULL))
+  }
+
+  cli::cli_inform(
+    paste0(
+      "Columns in `.data` not in feature(s): ",
+      ifelse(
+        length(nin_feature) > 1,
+        paste0(nin_feature, collapse = ", "),
+        nin_feature
+      )
+    )
+  )
+}
+
 
 # Delete Features ---------------------------------------------------------
 

diff --git a/R/arc-open.R b/R/arc-open.R
@@ -58,7 +58,7 @@
 #'}
 arc_open <- function(url, token = arc_token()) {
 
-  stopifnot("`url` must be of length 1" = length(url) == 1)
+  check_url(url)
 
   # extract layer metadata
   meta <- compact(fetch_layer_metadata(url, token))
@@ -78,7 +78,9 @@ arc_open <- function(url, token = arc_token()) {
     } else if ("layers" %in% names(meta) || grepl("FeatureServer", meta[["url"]])) {
       layer_class <- "FeatureServer"
     } else {
-      stop("Cannot determine layer type")
+      cli::cli_abort(
+        "Can't determine layer type from {.arg url}: {.url {url}}"
+      )
     }
   }
 
@@ -103,7 +105,7 @@ arc_open <- function(url, token = arc_token()) {
     "GroupLayer" = structure(meta, class = layer_class),
     cli::cli_abort(
       c(
-        "Unsupported service type",
+        "Service type {.val {layer_class}} is not supported.",
         "i"=  "Please report this at {.url https://github.com/R-ArcGIS/arcgislayers/issues}"
       )
     )