diff --git a/R/board.R b/R/board.R index b67f31516..f889e4dd3 100644 --- a/R/board.R +++ b/R/board.R @@ -124,7 +124,7 @@ board_cache_path <- function(name) { # R_CONFIG_ACTIVE suggests we're in a production environment if (has_envvars("R_CONFIG_ACTIVE") || has_envvars("PINS_USE_CACHE")) { path <- fs::dir_create(tempdir(), "pins") - } else if (has_envvars("PINS_CACHE_DIR") ) { + } else if (has_envvars("PINS_CACHE_DIR")) { path <- Sys.getenv("PINS_CACHE_DIR") } else { path <- cache_dir() @@ -208,7 +208,9 @@ board_deparse.pins_board <- function(board, ...) { write_board_manifest <- function(board, ...) { manifest <- make_manifest(board) write_board_manifest_yaml(board, manifest, ...) - pins_inform("Manifest file written to root folder of board, as `{manifest_pin_yaml_filename}`") + pins_inform( + "Manifest file written to root folder of board, as `{manifest_pin_yaml_filename}`" + ) invisible(board) } @@ -223,7 +225,7 @@ make_manifest <- function(board) { result <- map( pin_names, - ~fs::path(.x, pin_versions(board, name = .x)$version) |> + ~ fs::path(.x, pin_versions(board, name = .x)$version) |> end_with_slash() |> # versions usually don't include slash as.list() ) @@ -267,4 +269,3 @@ board_empty_results <- function() { class = character() ) } - diff --git a/R/board_azure.R b/R/board_azure.R index 1bc3a4368..b3848800b 100644 --- a/R/board_azure.R +++ b/R/board_azure.R @@ -56,7 +56,13 @@ #' board |> pin_list() #' board |> pin_read("iris") #' } -board_azure <- function(container, path = "", n_processes = 10, versioned = TRUE, cache = NULL) { +board_azure <- function( + container, + path = "", + n_processes = 10, + versioned = TRUE, + cache = NULL +) { check_installed("AzureStor") if (path == "/") { @@ -66,7 +72,10 @@ board_azure <- function(container, path = "", n_processes = 10, versioned = TRUE cache <- cache %||% board_cache_path(paste0("azure-", hash(board_path))) if (path != "") { if (inherits(container, "file_share")) { - try(AzureStor::create_storage_dir(container, path, recursive = TRUE), silent = TRUE) + try( + AzureStor::create_storage_dir(container, path, recursive = TRUE), + silent = TRUE + ) } else { AzureStor::create_storage_dir(container, path) } @@ -88,8 +97,11 @@ board_azure_test <- function(path, type = c("blob", "file", "dfs"), ...) { type <- arg_match(type) acct_name <- Sys.getenv("PINS_AZURE_ACCOUNT") - acct_url <- sprintf("https://%s.%s.core.windows.net/pins-rstats-testing-ci", - acct_name, type) + acct_url <- sprintf( + "https://%s.%s.core.windows.net/pins-rstats-testing-ci", + acct_name, + type + ) container <- AzureStor::storage_container( acct_url, @@ -135,7 +147,9 @@ pin_meta.pins_board_azure <- function(board, name, version = NULL, ...) { metadata_blob <- fs::path(name, version, "data.txt") metadata_absolute_path <- azure_normalize_path(board, metadata_blob) - if (!AzureStor::storage_file_exists(board$container, metadata_absolute_path)) { + if ( + !AzureStor::storage_file_exists(board$container, metadata_absolute_path) + ) { abort_pin_version_missing(version) } path_version <- fs::path(board$cache, name, version) @@ -162,10 +176,21 @@ pin_fetch.pins_board_azure <- function(board, name, version = NULL, ...) { } #' @export -pin_store.pins_board_azure <- function(board, name, paths, metadata, - versioned = NULL, ...) { +pin_store.pins_board_azure <- function( + board, + name, + paths, + metadata, + versioned = NULL, + ... +) { check_pin_name(name) - version <- version_setup(board, name, version_name(metadata), versioned = versioned) + version <- version_setup( + board, + name, + version_name(metadata), + versioned = versioned + ) version_dir <- azure_normalize_path(board, name, version) @@ -203,7 +228,6 @@ board_deparse.pins_board_azure <- function(board, ...) { #' @export write_board_manifest_yaml.pins_board_azure <- function(board, manifest, ...) { - paths <- AzureStor::list_storage_files(board$container, info = "name") if (manifest_pin_yaml_filename %in% paths) { @@ -254,8 +278,14 @@ azure_dir_exists <- function(board, path) { AzureStor::storage_dir_exists(board$container, dir) } -local_azure_progress <- function(progress = is_interactive(), env = parent.frame()) { - withr::local_options(list(azure_storage_progress_bar = progress), .local_envir = env) +local_azure_progress <- function( + progress = is_interactive(), + env = parent.frame() +) { + withr::local_options( + list(azure_storage_progress_bar = progress), + .local_envir = env + ) } azure_download <- function(board, keys, progress = is_interactive()) { @@ -266,7 +296,9 @@ azure_download <- function(board, keys, progress = is_interactive()) { needed <- !fs::file_exists(paths) if (any(needed)) { AzureStor::storage_multidownload( - board$container, keys[needed], paths[needed], + board$container, + keys[needed], + paths[needed], max_concurrent_transfers = board$n_processes ) fs::file_chmod(paths[needed], "u=r") diff --git a/R/board_connect.R b/R/board_connect.R index d47e0240a..5d42536a2 100644 --- a/R/board_connect.R +++ b/R/board_connect.R @@ -79,15 +79,16 @@ #' # Download a shared dataset #' board |> pin_read("timothy/mtcars") #' } -board_connect <- function(auth = c("auto", "manual", "envvar", "rsconnect"), - server = NULL, - account = NULL, - key = NULL, - cache = NULL, - name = "posit-connect", - versioned = TRUE, - use_cache_on_failure = is_interactive()) { - +board_connect <- function( + auth = c("auto", "manual", "envvar", "rsconnect"), + server = NULL, + account = NULL, + key = NULL, + cache = NULL, + name = "posit-connect", + versioned = TRUE, + use_cache_on_failure = is_interactive() +) { server <- rsc_server(auth, server, account, key) cache <- cache %||% board_cache_path(paste0("connect-", hash(server$url))) @@ -97,7 +98,7 @@ board_connect <- function(auth = c("auto", "manual", "envvar", "rsconnect"), name = name, cache = cache, url = server$url, - account = server$account, # for full name of pin + account = server$account, # for full name of pin server_name = server$server_name, # for board_connect(server = "...") in template auth = server$auth, versioned = versioned, @@ -127,16 +128,17 @@ board_connect <- function(auth = c("auto", "manual", "envvar", "rsconnect"), #' @rdname board_connect #' @export -board_rsconnect <- function(auth = c("auto", "manual", "envvar", "rsconnect"), - server = NULL, - account = NULL, - key = NULL, - output_files = FALSE, - cache = NULL, - name = "posit-connect", - versioned = TRUE, - use_cache_on_failure = is_interactive()) { - +board_rsconnect <- function( + auth = c("auto", "manual", "envvar", "rsconnect"), + server = NULL, + account = NULL, + key = NULL, + output_files = FALSE, + cache = NULL, + name = "posit-connect", + versioned = TRUE, + use_cache_on_failure = is_interactive() +) { lifecycle::deprecate_stop("1.1.0", "board_rsconnect()", "board_connect()") board_connect( @@ -258,16 +260,16 @@ pin_fetch.pins_board_connect <- function(board, name, version = NULL, ...) { #' @export pin_store.pins_board_connect <- function( - board, - name, - paths, - metadata, - versioned = NULL, - x = NULL, - ..., - access_type = NULL, - preview_data = TRUE) -{ + board, + name, + paths, + metadata, + versioned = NULL, + x = NULL, + ..., + access_type = NULL, + preview_data = TRUE +) { # https://docs.posit.co/connect/1.8.0.4/cookbook/deploying/ check_pin_name(rsc_parse_name(name)$name) @@ -290,7 +292,14 @@ pin_store.pins_board_connect <- function( ) # Make .tar.gz bundle containing data.txt + index.html + pin data - bundle_dir <- rsc_bundle(board, name, paths, metadata, x, preview_data = preview_data) + bundle_dir <- rsc_bundle( + board, + name, + paths, + metadata, + x, + preview_data = preview_data + ) bundle_file <- fs::file_temp(ext = "tar.gz") # suppress warnings about "invalid uid value" / "invalid gid value" @@ -306,7 +315,8 @@ pin_store.pins_board_connect <- function( # Upload bundle # https://docs.rstudio.com/connect/api/#post-/v1/content/{guid}/bundles json <- rsc_POST( - board, rsc_v1("content", content_guid, "bundles"), + board, + rsc_v1("content", content_guid, "bundles"), body = httr::upload_file(bundle_file) ) bundle_id <- json$id @@ -314,7 +324,8 @@ pin_store.pins_board_connect <- function( # Deploy bundle # https://docs.rstudio.com/connect/api/#post-/v1/experimental/content/{guid}/deploy json <- rsc_POST( - board, rsc_v1("content", content_guid, "deploy"), + board, + rsc_v1("content", content_guid, "deploy"), body = list(bundle_id = bundle_id), ) task_id <- json$task_id @@ -324,7 +335,8 @@ pin_store.pins_board_connect <- function( json <- rsc_GET(board, rsc_v1("tasks", task_id), list(wait = 1)) while (!json$finished) { json <- rsc_GET( - board, rsc_v1("tasks", task_id), + board, + rsc_v1("tasks", task_id), list(wait = 1, first = json$last) ) } @@ -382,19 +394,27 @@ required_pkgs.pins_board_connect <- function(x, ...) { # v0 ---------------------------------------------------------------------- #' @export -board_pin_get.pins_board_connect <- function(board, name, version = NULL, ..., - extract = NULL) { - +board_pin_get.pins_board_connect <- function( + board, + name, + version = NULL, + ..., + extract = NULL +) { meta <- pin_fetch(board, name, version = version, ...) meta$local$dir } #' @export -board_pin_create.pins_board_connect <- function(board, path, name, - metadata, code = NULL, - search_all = FALSE, - ...) { - +board_pin_create.pins_board_connect <- function( + board, + path, + name, + metadata, + code = NULL, + search_all = FALSE, + ... +) { path <- fs::dir_ls(path) metadata$file <- fs::path_file(path) @@ -408,13 +428,14 @@ board_pin_create.pins_board_connect <- function(board, path, name, } #' @export -board_pin_find.pins_board_connect <- function(board, - text = NULL, - name = NULL, - extended = FALSE, - metadata = FALSE, - ...) { - +board_pin_find.pins_board_connect <- function( + board, + text = NULL, + name = NULL, + extended = FALSE, + metadata = FALSE, + ... +) { params <- list( search = text, filter = "content_type:pin", @@ -436,7 +457,6 @@ board_pin_find.pins_board_connect <- function(board, # Content ----------------------------------------------------------------- rsc_content_find <- function(board, name, version = NULL, warn = TRUE) { - name <- rsc_parse_name(name) # https://docs.rstudio.com/connect/api/#get-/v1/content @@ -457,7 +477,9 @@ rsc_content_find <- function(board, name, version = NULL, warn = TRUE) { name$full <- paste0(owner, "/", name$name) if (warn) { - cli::cli_alert_warning("Use a fully specified name including user name: {.val {name$full}}, not {.val {name$name}}.") + cli::cli_alert_warning( + "Use a fully specified name including user name: {.val {name$full}}, not {.val {name$name}}." + ) } selected <- json[[1]] } else { @@ -551,7 +573,9 @@ rsc_content_version_cached <- function(board, guid) { if (length(meta) == 0) { abort("Failed to connect to Posit Connect") } else { - cli::cli_alert_danger("Failed to connect to Posit Connect; using cached version") + cli::cli_alert_danger( + "Failed to connect to Posit Connect; using cached version" + ) info <- fs::file_info(meta) meta <- meta[order(info$modification_time, decreasing = TRUE)] @@ -685,9 +709,7 @@ rsc_auth <- function(board, path, verb, body_path) { } rsc_check_status <- function(req) { - if (httr::status_code(req) < 400) { - - } else { + if (httr::status_code(req) < 400) {} else { type <- httr::parse_media(httr::headers(req)$`content-type`) if (type$complete == "application/json") { json <- httr::content(req) @@ -731,9 +753,16 @@ connect_has_ptd <- function() { board_connect_ptd <- function(...) { if (!connect_has_ptd()) { - testthat::skip("board_connect_ptd() only works with Posit's demo PTD server") + testthat::skip( + "board_connect_ptd() only works with Posit's demo PTD server" + ) } - board_connect(..., server = "pub.demo.posit.team", auth = "rsconnect", cache = fs::file_temp()) + board_connect( + ..., + server = "pub.demo.posit.team", + auth = "rsconnect", + cache = fs::file_temp() + ) } board_connect_susan <- function(...) { @@ -760,7 +789,6 @@ read_creds <- function() { readRDS(path) } add_another_user <- function(board, user_name, content_id) { - ## get user GUID for new owner from user_name path <- glue("v1/users/") path <- rsc_path(board, path) @@ -772,11 +800,13 @@ add_another_user <- function(board, user_name, content_id) { principal_guid <- res$results[[1]]$guid ## add user_name as owner for content at GUID - body <- glue('{{ + body <- glue( + '{{ "principal_guid": "{principal_guid}", "principal_type": "user", "role": "owner" - }}') + }}' + ) path <- glue("v1/content/{content_id}/permissions") path <- rsc_path(board, path) diff --git a/R/board_connect_bundle.R b/R/board_connect_bundle.R index cadbc95c1..f4678a1d7 100644 --- a/R/board_connect_bundle.R +++ b/R/board_connect_bundle.R @@ -1,4 +1,12 @@ -rsc_bundle <- function(board, name, paths, metadata, x = NULL, bundle_path = tempfile(), preview_data = TRUE) { +rsc_bundle <- function( + board, + name, + paths, + metadata, + x = NULL, + bundle_path = tempfile(), + preview_data = TRUE +) { fs::dir_create(bundle_path) # Bundle contains: @@ -13,7 +21,11 @@ rsc_bundle <- function(board, name, paths, metadata, x = NULL, bundle_path = tem # * manifest.json (used for deployment) manifest <- rsc_bundle_manifest(board, bundle_path) - jsonlite::write_json(manifest, fs::path(bundle_path, "manifest.json"), auto_unbox = TRUE) + jsonlite::write_json( + manifest, + fs::path(bundle_path, "manifest.json"), + auto_unbox = TRUE + ) invisible(bundle_path) } @@ -39,7 +51,14 @@ rsc_bundle_manifest <- function(board, path) { ) } -rsc_bundle_preview_create <- function(board, name, x, metadata, path, preview_data) { +rsc_bundle_preview_create <- function( + board, + name, + x, + metadata, + path, + preview_data +) { # Copy support files template <- fs::dir_ls(fs::path_package("pins", "preview")) file.copy(template, path, recursive = TRUE) @@ -51,18 +70,46 @@ rsc_bundle_preview_create <- function(board, name, x, metadata, path, preview_da invisible(path) } -rsc_bundle_preview_index <- function(board, name, x, metadata, preview_data = TRUE) { +rsc_bundle_preview_index <- function( + board, + name, + x, + metadata, + preview_data = TRUE +) { data_preview <- rsc_bundle_preview_data(x, preview_data) name <- rsc_parse_name(name) owner <- name$owner %||% board$account data <- list( - pin_files = paste0("", metadata$file, "", collapse = ", "), + pin_files = paste0( + "", + metadata$file, + "", + collapse = ", " + ), data_preview = jsonlite::toJSON(data_preview, auto_unbox = TRUE), - data_preview_style = if ( is.data.frame(x) && preview_data ) "" else "display:none", - urls = paste0("", metadata$urls, "", collapse = ", "), + data_preview_style = if (is.data.frame(x) && preview_data) { + "" + } else { + "display:none" + }, + urls = paste0( + "", + metadata$urls, + "", + collapse = ", " + ), url_preview_style = if (!is.null(metadata$urls)) "" else "display:none", - show_python_style = if (all(metadata$type %in% c("rds", "qs", "qs2"))) "display:none" else "", + show_python_style = if (all(metadata$type %in% c("rds", "qs", "qs2"))) { + "display:none" + } else { + "" + }, pin_name = paste0(owner, "/", name$name), pin_metadata = list( as_yaml = yaml::as.yaml(metadata), @@ -79,7 +126,7 @@ rsc_bundle_preview_index <- function(board, name, x, metadata, preview_data = TR } rsc_bundle_preview_data <- function(df, preview = TRUE, n = 100) { - if ( !is.data.frame(df) || !preview ) { + if (!is.data.frame(df) || !preview) { return(list(data = list(), columns = list())) } @@ -108,7 +155,12 @@ rsc_bundle_preview_data <- function(df, preview = TRUE, n = 100) { sanitise_col <- function(x) { # Basic classes can be left as is - if (is_bare_atomic(x) || is.factor(x) || inherits(x, "Date") || inherits(x, "POSIXt")) { + if ( + is_bare_atomic(x) || + is.factor(x) || + inherits(x, "Date") || + inherits(x, "POSIXt") + ) { return(x) } diff --git a/R/board_connect_server.R b/R/board_connect_server.R index 523d2f5c9..04d9802ff 100644 --- a/R/board_connect_server.R +++ b/R/board_connect_server.R @@ -8,15 +8,23 @@ rsc_server <- function(auth, server = NULL, account = NULL, key = NULL) { rsc_server_manual(server, key) } else if (auth == "envvar") { rsc_server_manual( - server %||% envvar_get("CONNECT_SERVER") %||% abort("Can't find CONNECT_SERVER env var"), - key %||% envvar_get("CONNECT_API_KEY") %||% abort("Can't find CONNECT_API_KEY env var") + server %||% + envvar_get("CONNECT_SERVER") %||% + abort("Can't find CONNECT_SERVER env var"), + key %||% + envvar_get("CONNECT_API_KEY") %||% + abort("Can't find CONNECT_API_KEY env var") ) } else { rsc_server_rsconnect(server, account) } } -check_auth <- function(auth = c("auto", "manual", "envvar", "rsconnect"), server = NULL, key = NULL) { +check_auth <- function( + auth = c("auto", "manual", "envvar", "rsconnect"), + server = NULL, + key = NULL +) { auth <- arg_match(auth) if (auth != "auto") { return(auth) @@ -87,12 +95,12 @@ rsc_server_rsconnect <- function(server = NULL, name = NULL) { accounts <- accounts[accounts$name == name, , drop = FALSE] } - if (nrow(accounts) > 1) ( - abort(c( + if (nrow(accounts) > 1) { + (abort(c( "Found multiple matching Posit Connect servers", i = "Please disambiguate with `server` and/or `account`" - )) - ) + ))) + } server_info <- rsconnect::serverInfo(accounts$server) account_info <- rsconnect::accountInfo(accounts$name, accounts$server) diff --git a/R/board_connect_url.R b/R/board_connect_url.R index 0c97444ed..b888b4e98 100644 --- a/R/board_connect_url.R +++ b/R/board_connect_url.R @@ -8,7 +8,7 @@ #' #' @param vanity_urls A named character vector of #' [Connect vanity URLs](https://docs.posit.co/connect/user/content-settings/#custom-url), -#' including trailing slash. This board is read only, and the best way to write to a pin +#' including trailing slash. This board is read only, and the best way to write to a pin #' on Connect is [board_connect()]. #' @family boards #' @inheritParams new_board @@ -27,10 +27,12 @@ #' #' board |> pin_read("my_vanity_url_pin") #' -board_connect_url <- function(vanity_urls, - cache = NULL, - use_cache_on_failure = is_interactive(), - headers = connect_auth_headers()) { +board_connect_url <- function( + vanity_urls, + cache = NULL, + use_cache_on_failure = is_interactive(), + headers = connect_auth_headers() +) { board_url( urls = vanity_urls, cache = cache, @@ -77,7 +79,9 @@ board_connect_url_test <- function(...) { board_connect_url_ptd <- function(...) { if (!connect_has_ptd()) { - testthat::skip("board_connect_url_ptd() only works with Posit's demo server") + testthat::skip( + "board_connect_url_ptd() only works with Posit's demo server" + ) } board_connect_url(..., cache = fs::file_temp()) } diff --git a/R/board_databricks.R b/R/board_databricks.R index a692294a0..7d5334360 100644 --- a/R/board_databricks.R +++ b/R/board_databricks.R @@ -57,12 +57,12 @@ #' } #' @export board_databricks <- function( - folder_url, - host = NULL, - prefix = NULL, - versioned = TRUE, - cache = NULL) { - + folder_url, + host = NULL, + prefix = NULL, + versioned = TRUE, + cache = NULL +) { check_installed("httr2") cache_path <- tolower(fs::path("databricks", folder_url, prefix %||% "")) @@ -117,7 +117,12 @@ pin_meta.pins_board_databricks <- function(board, name, version = NULL, ...) { abort_pin_version_missing(version) } db_download_file(board, name, version, "data.txt") - path_version <- fs::path(board$cache, board$prefix %||% "", name, version %||% "") + path_version <- fs::path( + board$cache, + board$prefix %||% "", + name, + version %||% "" + ) local_meta( x = read_meta(path_version), name = name, @@ -127,8 +132,15 @@ pin_meta.pins_board_databricks <- function(board, name, version = NULL, ...) { } #' @export -pin_store.pins_board_databricks <- function(board, name, paths, metadata, - versioned = NULL, x = NULL, ...) { +pin_store.pins_board_databricks <- function( + board, + name, + paths, + metadata, + versioned = NULL, + x = NULL, + ... +) { check_dots_used() check_pin_name(name) version <- version_setup( @@ -181,7 +193,12 @@ pin_delete.pins_board_databricks <- function(board, names, ...) { } #' @export -pin_version_delete.pins_board_databricks <- function(board, name, version, ...) { +pin_version_delete.pins_board_databricks <- function( + board, + name, + version, + ... +) { db_delete_pin(board, fs::path(name, version)) } @@ -230,7 +247,12 @@ db_download_file <- function(board, name = "", version = "", file_name = "") { return(invisible()) } try(fs::dir_create(cache_path)) - full_path <- fs::path("/api/2.0/fs/files", board$folder_url, base_path, file_name) + full_path <- fs::path( + "/api/2.0/fs/files", + board$folder_url, + base_path, + file_name + ) out <- db_req_init(board, "GET", full_path) out <- httr2::req_perform(out, path = local_path) fs::file_chmod(local_path, "u=r") @@ -314,7 +336,7 @@ db_list_contents <- function(board, path = NULL) { cli::cli_abort( message = unlist(strsplit(out, "\n")), call = NULL - ) + ) } } out <- httr2::resp_body_json(out) diff --git a/R/board_folder.R b/R/board_folder.R index ba83682b3..f8b0860de 100644 --- a/R/board_folder.R +++ b/R/board_folder.R @@ -25,7 +25,8 @@ board_folder <- function(path, versioned = FALSE) { fs::dir_create(path) path <- fs::path_norm(path) - new_board_v1("pins_board_folder", + new_board_v1( + "pins_board_folder", cache = NA_character_, path = path, versioned = versioned @@ -52,7 +53,7 @@ board_temp <- function(versioned = FALSE) { #' @export pin_list.pins_board_folder <- function(board, ...) { - fs::path_file(fs::dir_ls(board$path, type = "directory")) + fs::path_file(fs::dir_ls(board$path, type = "directory")) } #' @export @@ -70,10 +71,21 @@ pin_delete.pins_board_folder <- function(board, names, ...) { } #' @export -pin_store.pins_board_folder <- function(board, name, paths, metadata, - versioned = NULL, ...) { +pin_store.pins_board_folder <- function( + board, + name, + paths, + metadata, + versioned = NULL, + ... +) { check_pin_name(name) - version <- version_setup(board, name, version_name(metadata), versioned = versioned) + version <- version_setup( + board, + name, + version_name(metadata), + versioned = versioned + ) version_dir <- fs::path(board$path, name, version) fs::dir_create(version_dir) diff --git a/R/board_gcs.R b/R/board_gcs.R index c6e58d990..98685cfbc 100644 --- a/R/board_gcs.R +++ b/R/board_gcs.R @@ -46,11 +46,7 @@ #' # Pass arguments like `predefinedAcl` through the dots of `pin_write`: #' board |> pin_write(mtcars, predefinedAcl = "publicRead") #' } -board_gcs <- function(bucket, - prefix = NULL, - versioned = TRUE, - cache = NULL) { - +board_gcs <- function(bucket, prefix = NULL, versioned = TRUE, cache = NULL) { check_installed("googleCloudStorageR") # Check that have access to the bucket @@ -68,14 +64,21 @@ board_gcs <- function(bucket, } board_gcs_test <- function(...) { - skip_if_missing_envvars( tests = "board_gcs()", envvars = c("PINS_GCS_PASSWORD") ) - path_to_encrypted_json <- fs::path_package("pins", "secret", "pins-gcs-testing.json") - raw <- readBin(path_to_encrypted_json, "raw", file.size(path_to_encrypted_json)) + path_to_encrypted_json <- fs::path_package( + "pins", + "secret", + "pins-gcs-testing.json" + ) + raw <- readBin( + path_to_encrypted_json, + "raw", + file.size(path_to_encrypted_json) + ) pw <- Sys.getenv("PINS_GCS_PASSWORD", "") json <- sodium::data_decrypt( bin = raw, @@ -165,12 +168,24 @@ pin_fetch.pins_board_gcs <- function(board, name, version = NULL, ...) { } #' @export -pin_store.pins_board_gcs <- function(board, name, paths, metadata, - versioned = NULL, x = NULL, ...) { +pin_store.pins_board_gcs <- function( + board, + name, + paths, + metadata, + versioned = NULL, + x = NULL, + ... +) { withr::local_options(list(googleAuthR.verbose = 4)) check_dots_used() check_pin_name(name) - version <- version_setup(board, name, version_name(metadata), versioned = versioned) + version <- version_setup( + board, + name, + version_name(metadata), + versioned = versioned + ) version_dir <- fs::path(name, version) gcs_upload_yaml( board, diff --git a/R/board_gdrive.R b/R/board_gdrive.R index cf720785a..0fc66c27c 100644 --- a/R/board_gdrive.R +++ b/R/board_gdrive.R @@ -28,9 +28,7 @@ #' board |> pin_write(1:10, "great-integers", type = "json") #' board |> pin_read("great-integers") #' } -board_gdrive <- function(path, - versioned = TRUE, - cache = NULL) { +board_gdrive <- function(path, versioned = TRUE, cache = NULL) { check_installed("googledrive") dribble <- googledrive::as_dribble(path) @@ -75,7 +73,7 @@ pin_delete.pins_board_gdrive <- function(board, names, ...) { for (name in names) { check_pin_exists(board, name) dribble <- googledrive::drive_ls(board$dribble) - dribble <- dribble[dribble$name == name,] + dribble <- dribble[dribble$name == name, ] googledrive::drive_trash(dribble) } invisible(board) @@ -85,9 +83,9 @@ pin_delete.pins_board_gdrive <- function(board, names, ...) { pin_version_delete.pins_board_gdrive <- function(board, name, version, ...) { check_pin_exists(board, name) pin_dribble <- googledrive::drive_ls(board$dribble) - pin_dribble <- pin_dribble[pin_dribble$name == name,] + pin_dribble <- pin_dribble[pin_dribble$name == name, ] version_dribble <- googledrive::drive_ls(pin_dribble) - version_dribble <- version_dribble[version_dribble$name == version,] + version_dribble <- version_dribble[version_dribble$name == version, ] googledrive::drive_trash(version_dribble) invisible() } @@ -96,7 +94,7 @@ pin_version_delete.pins_board_gdrive <- function(board, name, version, ...) { pin_versions.pins_board_gdrive <- function(board, name, ...) { check_pin_exists(board, name) dribble <- googledrive::drive_ls(board$dribble) - dribble <- dribble[dribble$name == name,] + dribble <- dribble[dribble$name == name, ] path <- googledrive::as_dribble(dribble) version_from_path(sort(googledrive::drive_ls(path)$name)) } @@ -140,11 +138,22 @@ pin_fetch.pins_board_gdrive <- function(board, name, version = NULL, ...) { } #' @export -pin_store.pins_board_gdrive <- function(board, name, paths, metadata, - versioned = NULL, ...) { +pin_store.pins_board_gdrive <- function( + board, + name, + paths, + metadata, + versioned = NULL, + ... +) { googledrive::local_drive_quiet() check_pin_name(name) - version <- version_setup(board, name, version_name(metadata), versioned = versioned) + version <- version_setup( + board, + name, + version_name(metadata), + versioned = versioned + ) dir_dribble <- gdrive_mkdir(board$dribble, name) version_dir_dribble <- gdrive_mkdir(dir_dribble, version) @@ -189,7 +198,7 @@ gdrive_file_exists <- function(board, name) { dribble <- googledrive::drive_ls(board$dribble) path_components <- purrr::pluck(fs::path_split(fs::path_dir(name)), 1) for (path_component in path_components) { - dribble <- dribble[dribble$name == path_component,] + dribble <- dribble[dribble$name == path_component, ] dribble <- possibly_drive_ls(dribble) } name <- fs::path_file(name) @@ -201,7 +210,7 @@ gdrive_download <- function(board, key) { if (!fs::file_exists(path)) { dribble <- googledrive::as_dribble(fs::path_dir(key)) dribble <- googledrive::drive_ls(dribble) - dribble <- dribble[dribble$name == fs::path_file(key),] + dribble <- dribble[dribble$name == fs::path_file(key), ] googledrive::drive_download(dribble, path) fs::file_chmod(path, "u=r") } @@ -210,7 +219,7 @@ gdrive_download <- function(board, key) { gdrive_mkdir <- function(dribble, name) { dir_dribble <- googledrive::drive_ls(dribble, type = "folder") - dir_dribble <- dir_dribble[dir_dribble$name == name,] + dir_dribble <- dir_dribble[dir_dribble$name == name, ] if (googledrive::no_file(dir_dribble)) { dir_dribble <- googledrive::drive_mkdir(name, dribble, overwrite = FALSE) } diff --git a/R/board_kaggle.R b/R/board_kaggle.R index 0ebe12a04..eb1476b32 100644 --- a/R/board_kaggle.R +++ b/R/board_kaggle.R @@ -37,11 +37,16 @@ NULL #' head(read.csv(paths[[1]])) #' head(read.csv(paths[[2]])) #' } -board_kaggle_competitions <- function(username = NULL, key = NULL, cache = NULL) { +board_kaggle_competitions <- function( + username = NULL, + key = NULL, + cache = NULL +) { auth_info <- kaggle_authenticate(username, key) cache <- cache %||% board_cache_path("kaggle-competition") - new_board_v1("pins_board_kaggle_competition", + new_board_v1( + "pins_board_kaggle_competition", cache = cache, auth = httr::authenticate(auth_info$username, auth_info$key), username = auth_info$username @@ -51,7 +56,10 @@ board_kaggle_competitions <- function(username = NULL, key = NULL, cache = NULL) board_kaggle_competitions_test <- function() { envvars <- c("PINS_KAGGLE_USERNAME", "PINS_KAGGLE_KEY") if (!has_envvars(envvars)) { - testthat::skip(paste0("Kaggle tests require env vars ", paste0(envvars, collapse = ", "))) + testthat::skip(paste0( + "Kaggle tests require env vars ", + paste0(envvars, collapse = ", ") + )) } board_kaggle_competitions( @@ -65,14 +73,24 @@ board_kaggle_competitions_test <- function() { #' @rdname board_kaggle #' @export pin_search.pins_board_kaggle_competition <- function( - board, - search = NULL, - sort_by = c("grouped", "prize", "earliestDeadline", "latestDeadline", "numberOfTeams", "recentlyCreated"), - page = 1, - user = NULL, - ...) { + board, + search = NULL, + sort_by = c( + "grouped", + "prize", + "earliestDeadline", + "latestDeadline", + "numberOfTeams", + "recentlyCreated" + ), + page = 1, + user = NULL, + ... +) { sort_by <- arg_match(sort_by) - json <- kaggle_get(board, "competitions/list", + json <- kaggle_get( + board, + "competitions/list", query = list( search = search, sortBy = sort_by, @@ -110,8 +128,14 @@ pin_delete.pins_board_kaggle_competition <- function(board, names, ...) { } #' @export -pin_store.pins_board_kaggle_competition <- function(board, name, paths, metadata, - versioned = NULL, ...) { +pin_store.pins_board_kaggle_competition <- function( + board, + name, + paths, + metadata, + versioned = NULL, + ... +) { abort_board_read_only("board_kaggle_competitions") } @@ -144,7 +168,8 @@ pin_meta.pins_board_kaggle_competition <- function(board, name, ...) { created = parse_8601(competition$enabledDate), api_version = 1 ) - local_meta(meta, + local_meta( + meta, name = name, version = NA_character_, dir = fs::path(board$cache, name), @@ -162,7 +187,13 @@ pin_fetch.pins_board_kaggle_competition <- function(board, name, ...) { url <- kaggle_url("competitions", "data", "download", name, file_url) fs::dir_create(fs::path_dir(fs::path(meta$local$dir, file))) - http_download(url, path_dir = meta$local$dir, path_file = file, board$auth, on_failure = kaggle_json) + http_download( + url, + path_dir = meta$local$dir, + path_file = file, + board$auth, + on_failure = kaggle_json + ) } meta @@ -196,7 +227,8 @@ board_kaggle_dataset <- function(username = NULL, key = NULL, cache = NULL) { auth_info <- kaggle_authenticate(username, key) cache <- cache %||% board_cache_path("kaggle") - new_board_v1("pins_board_kaggle_dataset", + new_board_v1( + "pins_board_kaggle_dataset", cache = cache, auth = httr::authenticate(auth_info$username, auth_info$key), username = auth_info$username @@ -206,7 +238,10 @@ board_kaggle_dataset <- function(username = NULL, key = NULL, cache = NULL) { board_kaggle_dataset_test <- function() { envvars <- c("PINS_KAGGLE_USERNAME", "PINS_KAGGLE_KEY") if (!has_envvars(envvars)) { - testthat::skip(paste0("Kaggle tests require env vars ", paste0(envvars, collapse = ", "))) + testthat::skip(paste0( + "Kaggle tests require env vars ", + paste0(envvars, collapse = ", ") + )) } board_kaggle_dataset( @@ -240,14 +275,17 @@ pin_delete.pins_board_kaggle_dataset <- function(board, names, ...) { #' @param user If non-`NULL` filter to specified user. #' @export pin_search.pins_board_kaggle_dataset <- function( - board, - search = NULL, - sort_by = c("hottest", "votes", "updated", "active"), - page = 1, - user = NULL, - ...) { + board, + search = NULL, + sort_by = c("hottest", "votes", "updated", "active"), + page = 1, + user = NULL, + ... +) { sort_by <- arg_match(sort_by) - json <- kaggle_get(board, "datasets/list", + json <- kaggle_get( + board, + "datasets/list", query = list( search = search, sortBy = sort_by, @@ -280,7 +318,12 @@ pin_exists.pins_board_kaggle_dataset <- function(board, name, ...) { } #' @export -pin_meta.pins_board_kaggle_dataset <- function(board, name, version = NULL, ...) { +pin_meta.pins_board_kaggle_dataset <- function( + board, + name, + version = NULL, + ... +) { kaggle_check_name(name) view <- kaggle_get(board, paste0("datasets/view/", name)) list <- kaggle_get(board, paste0("datasets/list/", name)) @@ -294,7 +337,8 @@ pin_meta.pins_board_kaggle_dataset <- function(board, name, version = NULL, ...) created = parse_8601(view$lastUpdated), api_version = 1 ) - local_meta(meta, + local_meta( + meta, name = name, version = view$currentVersionNumber, dir = fs::path(board$cache, name), @@ -303,7 +347,12 @@ pin_meta.pins_board_kaggle_dataset <- function(board, name, version = NULL, ...) } #' @export -pin_fetch.pins_board_kaggle_dataset <- function(board, name, version = NULL, ...) { +pin_fetch.pins_board_kaggle_dataset <- function( + board, + name, + version = NULL, + ... +) { meta <- pin_meta(board, name) for (file in meta$file) { @@ -330,7 +379,6 @@ pin_versions.pins_board_kaggle_dataset <- function(board, name, ...) { notes = map_chr(versions, ~ .$versionNotes), status = map_chr(versions, ~ .$status) ) - } #' @export @@ -339,11 +387,16 @@ pin_versions.pins_board_kaggle_dataset <- function(board, name, ...) { #' @param private Should the dataset be private (`TRUE`, the default) #' or public (`FALSE`)? #' @param license How should the data be licensed? -pin_store.pins_board_kaggle_dataset <- function(board, name, paths, metadata, - versioned = NULL, ..., - private = TRUE, - license = "CC0-1.0") { - +pin_store.pins_board_kaggle_dataset <- function( + board, + name, + paths, + metadata, + versioned = NULL, + ..., + private = TRUE, + license = "CC0-1.0" +) { check_pin_name(name) versioned <- versioned %||% TRUE @@ -373,10 +426,7 @@ pin_store.pins_board_kaggle_dataset <- function(board, name, paths, metadata, ) } - resp <- httr::POST(url, board$auth, - body = body, - encode = "json" - ) + resp <- httr::POST(url, board$auth, body = body, encode = "json") kaggle_json(resp, "store pin") paste0(board$username, "/", name) @@ -393,7 +443,8 @@ kaggle_upload_file <- function(board, path) { modified <- as.integer(file.info(path)$mtime) url <- kaggle_url("datasets/upload/file", content_length, modified) - resp <- httr::POST(url, + resp <- httr::POST( + url, body = list(fileName = basename(path)), board$auth, encode = "form" @@ -401,10 +452,7 @@ kaggle_upload_file <- function(board, path) { json <- kaggle_json(resp, "Upload registration failed") token <- json$token - resp <- httr::PUT(json$createUrl, - body = httr::upload_file(path), - board$auth - ) + resp <- httr::PUT(json$createUrl, body = httr::upload_file(path), board$auth) json <- kaggle_json(resp, "Upload failed") token diff --git a/R/board_ms365.R b/R/board_ms365.R index 6e2d605e0..06f87c216 100644 --- a/R/board_ms365.R +++ b/R/board_ms365.R @@ -67,7 +67,13 @@ #' board_folder <- shared_items$remoteItem[[which(shared_items$name == "myboard")]] #' board <- board_ms365(od, board_folder) #' } -board_ms365 <- function(drive, path, versioned = TRUE, cache = NULL, delete_by_item = FALSE) { +board_ms365 <- function( + drive, + path, + versioned = TRUE, + cache = NULL, + delete_by_item = FALSE +) { check_installed("Microsoft365R") if (!inherits(drive, "ms_drive")) { @@ -81,8 +87,7 @@ board_ms365 <- function(drive, path, versioned = TRUE, cache = NULL, delete_by_i # try to create the board folder: ignore error if folder already exists try(drive$create_folder(path), silent = TRUE) folder <- drive$get_item(path) - } - else { + } else { folder <- path # ensure we have the correct properties for a shared item in OneDrive folder$sync_fields() @@ -93,7 +98,8 @@ board_ms365 <- function(drive, path, versioned = TRUE, cache = NULL, delete_by_i abort("Invalid path specified") } - cache <- cache %||% board_cache_path(paste0("ms365-", hash(folder$properties$id))) + cache <- cache %||% + board_cache_path(paste0("ms365-", hash(folder$properties$id))) new_board_v1( "pins_board_ms365", folder = folder, @@ -195,10 +201,21 @@ pin_fetch.pins_board_ms365 <- function(board, name, version = NULL, ...) { } #' @export -pin_store.pins_board_ms365 <- function(board, name, paths, metadata, - versioned = NULL, ...) { +pin_store.pins_board_ms365 <- function( + board, + name, + paths, + metadata, + versioned = NULL, + ... +) { check_pin_name(name) - version <- version_setup(board, name, version_name(metadata), versioned = versioned) + version <- version_setup( + board, + name, + version_name(metadata), + versioned = versioned + ) version_dir <- fs::path(name, version) diff --git a/R/board_s3.R b/R/board_s3.R index 0fc8fddbd..797e6d632 100644 --- a/R/board_s3.R +++ b/R/board_s3.R @@ -89,18 +89,18 @@ #' #' } board_s3 <- function( - bucket, - prefix = NULL, - versioned = TRUE, - access_key = NULL, - secret_access_key = NULL, - session_token = NULL, - credential_expiration = NULL, - profile = NULL, - region = NULL, - endpoint = NULL, - cache = NULL) { - + bucket, + prefix = NULL, + versioned = TRUE, + access_key = NULL, + secret_access_key = NULL, + session_token = NULL, + credential_expiration = NULL, + profile = NULL, + region = NULL, + endpoint = NULL, + cache = NULL +) { check_installed("paws.storage") config <- compact(list( @@ -121,13 +121,14 @@ board_s3 <- function( svc$head_bucket(bucket) cache <- cache %||% board_cache_path(paste0("s3-", bucket)) - new_board_v1("pins_board_s3", - name = "s3", - bucket = bucket, - prefix = prefix, - svc = svc, - cache = cache, - versioned = versioned + new_board_v1( + "pins_board_s3", + name = "s3", + bucket = bucket, + prefix = prefix, + svc = svc, + cache = cache, + versioned = versioned ) } @@ -137,18 +138,18 @@ board_s3_test <- function(...) { envvars = c("PINS_AWS_ACCESS_KEY", "PINS_AWS_SECRET_ACCESS_KEY") ) - board_s3("pins-test-hadley", - region = "us-east-2", - cache = tempfile(), - access_key = Sys.getenv("PINS_AWS_ACCESS_KEY"), - secret_access_key = Sys.getenv("PINS_AWS_SECRET_ACCESS_KEY"), - ... + board_s3( + "pins-test-hadley", + region = "us-east-2", + cache = tempfile(), + access_key = Sys.getenv("PINS_AWS_ACCESS_KEY"), + secret_access_key = Sys.getenv("PINS_AWS_SECRET_ACCESS_KEY"), + ... ) } #' @export pin_list.pins_board_s3 <- function(board, ...) { - resp <- board$svc$list_objects_v2( Bucket = board$bucket, Prefix = board$prefix, @@ -157,12 +158,13 @@ pin_list.pins_board_s3 <- function(board, ...) { final_list <- resp$CommonPrefixes - while(!is_empty(resp$NextContinuationToken)) { + while (!is_empty(resp$NextContinuationToken)) { resp <- board$svc$list_objects_v2( Bucket = board$bucket, Prefix = board$prefix, Delimiter = "/", - ContinuationToken = resp$NextContinuationToken) + ContinuationToken = resp$NextContinuationToken + ) final_list <- c(final_list, resp$CommonPrefixes) } @@ -191,16 +193,18 @@ pin_versions.pins_board_s3 <- function(board, name, ...) { resp <- board$svc$list_objects_v2( Bucket = board$bucket, Prefix = paste0(board$prefix, name, "/"), - Delimiter = "/") + Delimiter = "/" + ) final_list <- resp$CommonPrefixes - while(!is_empty(resp$NextContinuationToken)) { + while (!is_empty(resp$NextContinuationToken)) { resp <- board$svc$list_objects_v2( Bucket = board$bucket, Prefix = paste0(board$prefix, name, "/"), Delimiter = "/", - ContinuationToken = resp$NextContinuationToken) + ContinuationToken = resp$NextContinuationToken + ) final_list <- c(final_list, resp$CommonPrefixes) } @@ -249,11 +253,23 @@ pin_fetch.pins_board_s3 <- function(board, name, version = NULL, ...) { } #' @export -pin_store.pins_board_s3 <- function(board, name, paths, metadata, - versioned = NULL, x = NULL, ...) { +pin_store.pins_board_s3 <- function( + board, + name, + paths, + metadata, + versioned = NULL, + x = NULL, + ... +) { check_dots_used() check_pin_name(name) - version <- version_setup(board, name, version_name(metadata), versioned = versioned) + version <- version_setup( + board, + name, + version_name(metadata), + versioned = versioned + ) version_dir <- fs::path(name, version) s3_upload_yaml(board, fs::path(version_dir, "data.txt"), metadata, ...) diff --git a/R/board_url.R b/R/board_url.R index 68a9f66c4..6f6f798a9 100644 --- a/R/board_url.R +++ b/R/board_url.R @@ -86,11 +86,12 @@ #' b2 |> pin_list() #' b2 |> pin_versions("y") #' -board_url <- function(urls, - cache = NULL, - use_cache_on_failure = is_interactive(), - headers = NULL) { - +board_url <- function( + urls, + cache = NULL, + use_cache_on_failure = is_interactive(), + headers = NULL +) { check_headers(headers) url_format <- get_url_format(urls) if (url_format == "pins_yaml") { @@ -189,7 +190,6 @@ pin_meta.pins_board_url <- function(board, name, version = NULL, ...) { #' @export pin_versions.pins_board_url <- function(board, name, ...) { - if (!board$versioned) { abort_board_not_versioned("board_url") } @@ -239,8 +239,14 @@ pin_delete.pins_board_url <- function(board, names, ...) { } #' @export -pin_store.pins_board_url <- function(board, name, paths, metadata, - versioned = NULL, ...) { +pin_store.pins_board_url <- function( + board, + name, + paths, + metadata, + versioned = NULL, + ... +) { abort_board_read_only("board_url") } @@ -259,7 +265,9 @@ write_board_manifest_yaml.pins_board_url <- function(board, manifest, ...) { get_url_format <- function(urls) { if (is_scalar_character(urls) && !is_named(urls)) { "pins_yaml" - } else if (is_list(urls) && is_named(urls) && all(map_lgl(urls, is_character))) { + } else if ( + is_list(urls) && is_named(urls) && all(map_lgl(urls, is_character)) + ) { "manifest_content" } else if (is.character(urls) && is_named(urls)) { "vector_of_urls" @@ -328,10 +336,15 @@ get_manifest <- function(url, headers, call = rlang::caller_env()) { manifest } -http_download <- function(url, path_dir, path_file, ..., - use_cache_on_failure = FALSE, - headers = NULL, - on_failure = NULL) { +http_download <- function( + url, + path_dir, + path_file, + ..., + use_cache_on_failure = FALSE, + headers = NULL, + on_failure = NULL +) { cache_path <- download_cache_path(path_dir) cache <- read_cache(cache_path)[[url]] @@ -365,22 +378,30 @@ http_download <- function(url, path_dir, path_file, ..., ) if (is.null(req)) { - warn(glue("Downloading '{path_file}' failed; falling back to cached version")) + warn(glue( + "Downloading '{path_file}' failed; falling back to cached version" + )) cache$path } else if (httr::status_code(req) <= 200) { signal("", "pins_cache_downloaded") - if (fs::file_exists(path)) fs::file_chmod(path, "u+w") + if (fs::file_exists(path)) { + fs::file_chmod(path, "u+w") + } fs::file_copy(tmp_path, path, overwrite = TRUE) fs::file_chmod(path, "u=r") info <- httr::cache_info(req) if (info$cacheable) { - update_cache(cache_path, url, list( - expires = info$expires, - etag = info$etag, - modified = unclass(info$modified), - path = path - )) + update_cache( + cache_path, + url, + list( + expires = info$expires, + etag = info$etag, + modified = unclass(info$modified), + path = path + ) + ) } else { cli::cli_alert("{.url {url}} is not cacheable") } @@ -391,7 +412,9 @@ http_download <- function(url, path_dir, path_file, ..., cache$path } else { if (!is.null(cache) && use_cache_on_failure) { - warn(glue("Downloading '{path_file}' failed; falling back to cached version")) + warn(glue( + "Downloading '{path_file}' failed; falling back to cached version" + )) httr::warn_for_status(req) cache$path } else { @@ -443,7 +466,12 @@ http_date <- function(x = Sys.time(), tz = "UTC") { check_headers <- function(x, arg = caller_arg(x), call = caller_env()) { if (!is.null(x) && (!is_character(x) || !is_named(x))) { - stop_input_type(x, "a named character vector", allow_null = TRUE, arg = arg, call = call) + stop_input_type( + x, + "a named character vector", + allow_null = TRUE, + arg = arg, + call = call + ) } - } diff --git a/R/cache.R b/R/cache.R index 2f97f2d04..6846dff64 100644 --- a/R/cache.R +++ b/R/cache.R @@ -44,7 +44,9 @@ cache_prune <- function(days = 30) { } size <- dir_size(to_delete) - pins_inform("Delete {length(to_delete)} pin versions, freeing {format(size)} ?") + pins_inform( + "Delete {length(to_delete)} pin versions, freeing {format(size)} ?" + ) if (utils::menu(c("Yes", "No")) == 1) { fs::dir_delete(to_delete) diff --git a/R/legacy_azure.R b/R/legacy_azure.R index 5447bf067..01545c576 100644 --- a/R/legacy_azure.R +++ b/R/legacy_azure.R @@ -34,11 +34,15 @@ legacy_azure <- function( name = "azure", ... ) { - if (nchar(container) == 0) + if (nchar(container) == 0) { stop("The 'azure' board requires a 'container' parameter.") - if (nchar(account) == 0) + } + if (nchar(account) == 0) { stop("The 'azure' board requires an 'account' parameter.") - if (nchar(key) == 0) stop("The 'azure' board requires a 'key' parameter.") + } + if (nchar(key) == 0) { + stop("The 'azure' board requires a 'key' parameter.") + } azure_url <- paste0("https://", account, ".blob.core.windows.net/", container) diff --git a/R/legacy_board.R b/R/legacy_board.R index f87141fc0..27ec9b26a 100644 --- a/R/legacy_board.R +++ b/R/legacy_board.R @@ -1,4 +1,3 @@ - #' Custom Boards #' #' `r lifecycle::badge('deprecated')` diff --git a/R/legacy_board_registry.R b/R/legacy_board_registry.R index 0dc366355..6dfd6e29a 100644 --- a/R/legacy_board_registry.R +++ b/R/legacy_board_registry.R @@ -89,19 +89,27 @@ board_register_code <- function(board, name) { while (parent_idx < length(sys.parents())) { parent_func <- sys.function(sys.parent(parent_idx)) parent_call <- sys.call(sys.parent(parent_idx)) - if (!is.function(parent_func) || !is.call(parent_call)) break + if (!is.function(parent_func) || !is.call(parent_call)) { + break + } this_parent_call <- tryCatch( match.call(definition = parent_func, call = parent_call), error = function(e) NULL ) - if (is.null(this_parent_call)) break - if (length(this_parent_call) < 1) break + if (is.null(this_parent_call)) { + break + } + if (length(this_parent_call) < 1) { + break + } this_function_name <- deparse(this_parent_call[[1]]) - if (!grepl("(^|::)board_register", this_function_name)) break + if (!grepl("(^|::)board_register", this_function_name)) { + break + } parent_call <- this_parent_call function_name <- this_function_name @@ -120,8 +128,9 @@ board_register_code <- function(board, name) { #' @rdname board_register #' @export board_deregister <- function(name, ...) { - if (!name %in% board_registry_list()) + if (!name %in% board_registry_list()) { stop("Board '", name, "' is not registered.") + } board <- board_get(name) board_registry_set(name, NULL) diff --git a/R/legacy_datatxt.R b/R/legacy_datatxt.R index a52067246..7e954438a 100644 --- a/R/legacy_datatxt.R +++ b/R/legacy_datatxt.R @@ -88,7 +88,9 @@ file_path_null <- function(...) { } datatxt_refresh_index <- function(board) { - if (is.null(board$url)) stop("Invalid 'url' in '", board$name, "' board.") + if (is.null(board$url)) { + stop("Invalid 'url' in '", board$name, "' board.") + } index_file <- "data.txt" if (identical(board$index_randomize, TRUE)) { @@ -152,8 +154,11 @@ datatxt_pin_download_info <- function(board, name, ...) { } # try to download index as well - path_guess <- if (grepl(".*/.*\\.[a-zA-Z]+$", index_entry$path[1])) - dirname(index_entry$path[1]) else index_entry$path[1] + path_guess <- if (grepl(".*/.*\\.[a-zA-Z]+$", index_entry$path[1])) { + dirname(index_entry$path[1]) + } else { + index_entry$path[1] + } # if `path_guess` already has a scheme, don't prepend board URL path_guess <- if (grepl("^https?://", path_guess)) { @@ -320,8 +325,11 @@ board_pin_find.pins_board_datatxt <- function( if (nrow(results) == 1) { metadata <- jsonlite::fromJSON(results$metadata) - path_guess <- if (grepl("\\.[a-zA-Z]+$", metadata$path)) - dirname(metadata$path) else metadata$path + path_guess <- if (grepl("\\.[a-zA-Z]+$", metadata$path)) { + dirname(metadata$path) + } else { + metadata$path + } datatxt_path <- file_path_null( board$url, board$subpath, @@ -389,9 +397,14 @@ datatxt_update_index <- function( } index_matches <- sapply(index, function(e) identical(e$path, path)) - index_pos <- if (length(index_matches) > 0) which(index_matches) else + index_pos <- if (length(index_matches) > 0) { + which(index_matches) + } else { length(index) + 1 - if (length(index_pos) == 0) index_pos <- length(index) + 1 + } + if (length(index_pos) == 0) { + index_pos <- length(index) + 1 + } if (identical(operation, "create")) { metadata$columns <- NULL @@ -499,7 +512,9 @@ board_pin_create.pins_board_datatxt <- function( datatxt_pin_files <- function(board, name) { entry <- pin_find(name = name, board = board, metadata = TRUE) - if (nrow(entry) != 1) stop("Pin '", name, "' not found.") + if (nrow(entry) != 1) { + stop("Pin '", name, "' not found.") + } metadata <- jsonlite::fromJSON(as.list(entry)$metadata) files <- metadata$path diff --git a/R/legacy_dospaces.R b/R/legacy_dospaces.R index 033cdaef8..ac6ef4fea 100644 --- a/R/legacy_dospaces.R +++ b/R/legacy_dospaces.R @@ -34,13 +34,18 @@ legacy_dospace <- function( name = "dospace", ... ) { - if (nchar(space) == 0) + if (nchar(space) == 0) { stop("The 'dospace' board requires a 'space' parameter.") - if (nchar(key) == 0) stop("The 'dospace' board requires a 'key' parameter.") - if (nchar(secret) == 0) + } + if (nchar(key) == 0) { + stop("The 'dospace' board requires a 'key' parameter.") + } + if (nchar(secret) == 0) { stop("The 'dospace' board requires a 'secret' parameter.") - if (nchar(datacenter) == 0) + } + if (nchar(datacenter) == 0) { stop("The 'dospace' board requires a 'datacenter' parameter.") + } legacy_datatxt( name = name, diff --git a/R/legacy_gcloud.R b/R/legacy_gcloud.R index 57b6644e7..073a4d862 100644 --- a/R/legacy_gcloud.R +++ b/R/legacy_gcloud.R @@ -32,7 +32,9 @@ legacy_gcloud <- function( name = "gcloud", ... ) { - if (nchar(bucket) == 0) stop("Board 'gcloud' requires a 'bucket' parameter.") + if (nchar(bucket) == 0) { + stop("Board 'gcloud' requires a 'bucket' parameter.") + } if (is.null(token)) { token <- Sys.getenv("GOOGLE_STORAGE_ACCESS_TOKEN") @@ -167,24 +169,27 @@ gcloud_candidates <- function(binary) { binary_name <- paste(binary, "cmd", sep = ".") c( - function() + function() { file.path( appdata, "Google/Cloud SDK/google-cloud-sdk/bin", binary_name - ), - function() + ) + }, + function() { file.path( Sys.getenv("ProgramFiles"), "/Google/Cloud SDK/google-cloud-sdk/bin", binary_name - ), - function() + ) + }, + function() { file.path( Sys.getenv("ProgramFiles(x86)"), "/Google/Cloud SDK/google-cloud-sdk/bin", binary_name ) + } ) } else { binary_name <- binary @@ -192,12 +197,13 @@ gcloud_candidates <- function(binary) { c( function() Sys.which(binary_name), function() paste("~/google-cloud-sdk/bin", binary_name, sep = "/"), - function() + function() { file.path( Sys.getenv("GCLOUD_INSTALL_PATH", "~/google-cloud-sdk"), "bin", binary_name ) + } ) } } diff --git a/R/legacy_github.R b/R/legacy_github.R index 0f23cee58..ebfa49e73 100644 --- a/R/legacy_github.R +++ b/R/legacy_github.R @@ -196,9 +196,14 @@ github_update_temp_index <- function( } index_matches <- sapply(index, function(e) identical(e$path, path)) - index_pos <- if (length(index_matches) > 0) which(index_matches) else + index_pos <- if (length(index_matches) > 0) { + which(index_matches) + } else { length(index) + 1 - if (length(index_pos) == 0) index_pos <- length(index) + 1 + } + if (length(index_pos) == 0) { + index_pos <- length(index) + 1 + } if (identical(operation, "create")) { metadata$columns <- NULL @@ -304,8 +309,9 @@ github_create_release <- function(board, name) { index_url <- github_url(board, branch = NULL, "/commits/", board$branch) response <- httr::GET(index_url, github_headers(board)) version <- "initial" - if (!httr::http_error(response)) + if (!httr::http_error(response)) { version <- substr(httr::content(response, encoding = "UTF-8")$sha, 1, 7) + } release_url <- github_url(board, branch = NULL, "/releases") @@ -336,7 +342,7 @@ github_create_release <- function(board, name) { encode = "json" ) - if (httr::http_error(response)) + if (httr::http_error(response)) { stop( "Failed to create release '", release$tag_name, @@ -345,6 +351,7 @@ github_create_release <- function(board, name) { "': ", httr::content(response, encoding = "UTF-8")$message ) + } httr::content(response, encoding = "UTF-8") } @@ -360,13 +367,14 @@ github_upload_release <- function(board, release, name, file, file_path) { http_utils_progress("up", size = file.info(normalizePath(file_path))$size) ) - if (httr::http_error(response)) + if (httr::http_error(response)) { stop( "Failed to upload asset '", file, "': ", httr::content(response, encoding = "UTF-8")$message ) + } httr::content(response, encoding = "UTF-8")$url } @@ -573,7 +581,9 @@ board_pin_create.pins_board_github <- function( branch <- if (is.null(list(...)$branch)) board$branch else list(...)$branch release_storage <- identical(list(...)$release_storage, TRUE) - if (!file.exists(path)) stop("File does not exist: ", path) + if (!file.exists(path)) { + stop("File does not exist: ", path) + } if (!identical(branch, board$branch)) { if (!branch %in% github_branches(board)) { @@ -605,7 +615,9 @@ board_pin_create.pins_board_github <- function( release_storage) && !identical(file, "data.txt") ) { - if (is.null(release)) release <- github_create_release(board, name) + if (is.null(release)) { + release <- github_create_release(board, name) + } download_url <- github_upload_release( board, release, @@ -660,8 +672,11 @@ board_pin_create.pins_board_github <- function( } # add remaining files in a single commit - commit <- if (is.null(list(...)$commit)) paste("update", name) else + commit <- if (is.null(list(...)$commit)) { + paste("update", name) + } else { list(...)$commit + } github_files_commit(board, upload_defs, branch, commit) } @@ -755,8 +770,9 @@ github_branches <- function(board) { github_url(board, "/git", "/refs", branch = NULL), github_headers(board) ) - if (httr::http_error(response)) + if (httr::http_error(response)) { stop(httr::content(response, encoding = "UTF-8")) + } httr::content(response, encoding = "UTF-8") |> sapply(function(e) gsub("refs/heads/", "", e$ref)) @@ -782,7 +798,9 @@ github_branch <- function(board, branch) { httr::content(response, encoding = "UTF-8") ) - if (length(branch_object) != 1) stop("Failed to retrieve branch ", branch) + if (length(branch_object) != 1) { + stop("Failed to retrieve branch ", branch) + } branch_object[[1]] } @@ -852,7 +870,9 @@ github_download_files <- function(index, temp_path, board) { httr::content(encoding = "UTF-8") github_download_files(sub_index, file.path(temp_path, file$name), board) } else { - if (!dir.exists(temp_path)) dir.create(temp_path, recursive = TRUE) + if (!dir.exists(temp_path)) { + dir.create(temp_path, recursive = TRUE) + } httr::GET( file$download_url, httr::write_disk(file.path(temp_path, basename(file$download_url))), @@ -904,8 +924,11 @@ board_pin_get.pins_board_github <- function( file_name <- if ( !identical(names(index_path), NULL) && nchar(names(index_path)[file_idx]) > 0 - ) - names(index_path)[file_idx] else NULL + ) { + names(index_path)[file_idx] + } else { + NULL + } if (grepl("^http://|^https://", file)) { # manually move authorization to url due to https://github.com/octokit/rest.js/issues/967 @@ -985,8 +1008,11 @@ board_pin_remove.pins_board_github <- function(board, name, ...) { for (file in index) { pin_log("deleting ", file$name) - commit <- if (is.null(list(...)$commit)) paste("delete", file$name) else + commit <- if (is.null(list(...)$commit)) { + paste("delete", file$name) + } else { list(...)$commit + } response <- httr::DELETE( file.path(base_url, file$name), @@ -1017,13 +1043,14 @@ board_pin_remove.pins_board_github <- function(board, name, ...) { github_delete_release(board, name) } - if (update_index) + if (update_index) { github_update_index( board, paste0(board$path, name), commit, operation = "remove" ) + } } #' @export diff --git a/R/legacy_kaggle.R b/R/legacy_kaggle.R index 841141f7c..03cf9d4ea 100644 --- a/R/legacy_kaggle.R +++ b/R/legacy_kaggle.R @@ -90,15 +90,18 @@ kaggle_auth <- function(board) { kaggle_qualify_name <- function(name, board) { qualified <- name - if (!grepl("/", qualified)) + if (!grepl("/", qualified)) { qualified <- paste0(kaggle_auth_info(board)$username, "/", name) + } qualified } kaggle_upload_resource <- function(path, board) { path <- normalizePath(path) - if (!file.exists(path)) stop("Invalid path: ", path) + if (!file.exists(path)) { + stop("Invalid path: ", path) + } content_length <- file.info(path)$size modified <- as.integer(file.info(path)$mtime) @@ -116,13 +119,15 @@ kaggle_upload_resource <- function(path, board) { kaggle_auth(board) ) - if (httr::http_error(results)) + if (httr::http_error(results)) { stop("Upload registration failed with status ", httr::status_code(results)) + } parsed <- httr::content(results, encoding = "UTF-8") - if (!identical(parsed$error, NULL)) + if (!identical(parsed$error, NULL)) { stop("Upload registration failed: ", parsed$error) + } upload_url <- parsed$createUrl token <- parsed$token @@ -134,12 +139,15 @@ kaggle_upload_resource <- function(path, board) { http_utils_progress("up", size = file.info(normalizePath(path))$size) ) - if (httr::http_error(results)) + if (httr::http_error(results)) { stop("Upload failed with status ", httr::status_code(results)) + } parsed <- httr::content(results, encoding = "UTF-8") - if (!identical(parsed$error, NULL)) stop("Upload failed: ", parsed$error) + if (!identical(parsed$error, NULL)) { + stop("Upload failed: ", parsed$error) + } token } @@ -162,7 +170,9 @@ kaggle_create_resource <- function( sep = "/" ) - if (is.null(notes)) notes <- paste("Updated version") + if (is.null(notes)) { + notes <- paste("Updated version") + } body <- list( convertToCsv = jsonlite::unbox(FALSE), @@ -192,13 +202,15 @@ kaggle_create_resource <- function( results <- httr::POST(url, body = body, kaggle_auth(board), encode = "json") - if (httr::http_error(results)) + if (httr::http_error(results)) { stop("Resource creation failed with status ", httr::status_code(results)) + } parsed <- httr::content(results, encoding = "UTF-8") - if (!identical(parsed$error, NULL)) + if (!identical(parsed$error, NULL)) { stop("Resource creation failed: ", parsed$error) + } parsed$url } @@ -236,9 +248,12 @@ board_pin_create.pins_board_kaggle <- function( description <- metadata$description type <- metadata$type - if (is.null(description) || nchar(description) == 0) + if (is.null(description) || nchar(description) == 0) { description <- paste("A pin for the", gsub("-pin$", "", name), "dataset") - if (!file.exists(path)) stop("File does not exist: ", path) + } + if (!file.exists(path)) { + stop("File does not exist: ", path) + } if (identical(list(...)$use_zip, TRUE)) { temp_bundle <- kaggle_create_bundle(path, type, description) @@ -282,8 +297,9 @@ board_pin_search_kaggle <- function( url <- utils::URLencode(paste0(base_url, params)) results <- httr::GET(url, kaggle_auth(board)) - if (httr::http_error(results)) + if (httr::http_error(results)) { stop("Finding pin failed with status ", httr::status_code(results)) + } httr::content(results, encoding = "UTF-8") } @@ -295,7 +311,9 @@ board_pin_find.pins_board_kaggle <- function( extended = FALSE, ... ) { - if (is.null(text)) text <- "" + if (is.null(text)) { + text <- "" + } # clear name searches text <- gsub("^[^/]+/", "", text) @@ -356,8 +374,9 @@ kaggle_competition_files <- function(board, name) { ) results <- httr::GET(url, kaggle_auth(board)) - if (httr::http_error(results)) + if (httr::http_error(results)) { stop("Finding pin failed with status ", httr::status_code(results)) + } httr::content(results, encoding = "UTF-8") } @@ -385,16 +404,23 @@ board_pin_get.pins_board_kaggle <- function( etag <- max(sapply(files, function(e) e$creationDate)) content_length <- sum(sapply(files, function(e) e$totalBytes)) } else { - if (!grepl("/", name)) + if (!grepl("/", name)) { name <- paste(kaggle_auth_info(board)$username, name, sep = "/") + } url <- paste0("https://www.kaggle.com/api/v1/datasets/download/", name) extended <- pin_find(name = name, board = board, extended = TRUE) - etag <- if (is.null(extended$lastUpdated)) "" else + etag <- if (is.null(extended$lastUpdated)) { + "" + } else { as.character(extended$lastUpdated) - content_length <- if (is.null(extended$totalBytes)) 0 else + } + content_length <- if (is.null(extended$totalBytes)) { + 0 + } else { as.integer(extended$totalBytes) + } } subpath <- name @@ -435,15 +461,17 @@ board_browse.pins_board_kaggle <- function(board, ...) { #' @export board_pin_versions.pins_board_kaggle <- function(board, name, ...) { - if (!grepl("/", name)) + if (!grepl("/", name)) { name <- paste(kaggle_auth_info(board)$username, name, sep = "/") + } url <- paste0("https://www.kaggle.com/api/v1/datasets/view/", name) response <- httr::GET(url, kaggle_auth(board)) - if (httr::http_error(response)) + if (httr::http_error(response)) { stop("Failed to view dataset with status ", httr::status_code(response)) + } parsed <- httr::content(response, encoding = "UTF-8") @@ -460,8 +488,9 @@ board_pin_versions.pins_board_kaggle <- function(board, name, ...) { } kaggle_resource_exists <- function(board, name) { - if (!grepl("/", name)) + if (!grepl("/", name)) { name <- paste(kaggle_auth_info(board)$username, name, sep = "/") + } url <- paste0("https://www.kaggle.com/api/v1/datasets/view/", name) diff --git a/R/legacy_packages.R b/R/legacy_packages.R index 59fc86f4f..75068703f 100644 --- a/R/legacy_packages.R +++ b/R/legacy_packages.R @@ -1,8 +1,5 @@ board_packages <- function() { - new_board_v0("pins_board_packages", - name = "packages", - versions = FALSE - ) + new_board_v0("pins_board_packages", name = "packages", versions = FALSE) } #' @export diff --git a/R/legacy_pin_download.R b/R/legacy_pin_download.R index 6c6f5ab56..997b4ccba 100644 --- a/R/legacy_pin_download.R +++ b/R/legacy_pin_download.R @@ -1,28 +1,32 @@ pin_download_files <- function(path, ...) { for (p in path) { - if (length(path) > 1) pin_log("Downloading ", p, " from ", length(path), " downloads.") + if (length(path) > 1) { + pin_log("Downloading ", p, " from ", length(path), " downloads.") + } local_path <- pin_download_one(p, ...) } local_path } -pin_download_one <- function(path, - name, - board, - extract = FALSE, - custom_etag = "", - remove_query = FALSE, - config = NULL, - headers = NULL, - can_fail = FALSE, - cache = TRUE, - content_length = 0, - subpath = name, - details = new.env(), - download = TRUE, - download_name = NULL, - ...) { +pin_download_one <- function( + path, + name, + board, + extract = FALSE, + custom_etag = "", + remove_query = FALSE, + config = NULL, + headers = NULL, + can_fail = FALSE, + cache = TRUE, + content_length = 0, + subpath = name, + details = new.env(), + download = TRUE, + download_name = NULL, + ... +) { stopifnot(is.board(board)) must_download <- !cache @@ -41,7 +45,9 @@ pin_download_one <- function(path, dir.create(temp_path) on.exit(unlink(temp_path, recursive = TRUE)) - old_pin <- tryCatch(pin_registry_retrieve(board, name), error = function(e) NULL) + old_pin <- tryCatch(pin_registry_retrieve(board, name), error = function(e) { + NULL + }) old_cache <- old_pin$cache old_cache_missing <- TRUE @@ -49,15 +55,13 @@ pin_download_one <- function(path, if (is.null(old_cache)) { old_pin$cache <- old_cache <- list() cache_index <- 1 - } - else { + } else { cache_urls <- sapply(old_cache, function(e) e$url) cache_index <- which(cache_urls == path) if (length(cache_index) == 0) { old_cache <- list() cache_index <- length(cache_urls) + 1 - } - else { + } else { old_cache <- old_cache[[cache_index]] old_cache_missing <- FALSE } @@ -90,59 +94,116 @@ pin_download_one <- function(path, cache <- list() cache$etag <- old_cache$etag cache$max_age <- if (!is.numeric(old_cache$max_age)) 0 else old_cache$max_age - cache$change_age <- if (is.null(old_cache$change_age)) as.numeric(Sys.time()) - cache$max_age else old_cache$change_age + cache$change_age <- if (is.null(old_cache$change_age)) { + as.numeric(Sys.time()) - cache$max_age + } else { + old_cache$change_age + } cache$url <- path error <- NULL extract_type <- NULL - pin_log("Checking 'change_age' header (time, change age, max age): ", as.numeric(Sys.time()), ", ", cache$change_age, ", ", cache$max_age) + pin_log( + "Checking 'change_age' header (time, change age, max age): ", + as.numeric(Sys.time()), + ", ", + cache$change_age, + ", ", + cache$max_age + ) details$something_changed <- FALSE # skip downloading if max-age still valid - if (as.numeric(Sys.time()) >= cache$change_age + cache$max_age || must_download) { + if ( + as.numeric(Sys.time()) >= cache$change_age + cache$max_age || must_download + ) { skip_download <- FALSE if (is.character(custom_etag) && nchar(custom_etag) > 0) { - pin_log("Using custom 'etag' (old, new): ", old_cache$etag, ", ", custom_etag) + pin_log( + "Using custom 'etag' (old, new): ", + old_cache$etag, + ", ", + custom_etag + ) cache$etag <- custom_etag - } - else { - head_result <- catch_log(httr::HEAD(path, httr::timeout(5), headers, config)) + } else { + head_result <- catch_log(httr::HEAD( + path, + httr::timeout(5), + headers, + config + )) if (!is.null(head_result)) { cache$etag <- head_result$headers$etag - cache$max_age <- pin_file_cache_max_age(head_result$headers$`cache-control`) + cache$max_age <- pin_file_cache_max_age( + head_result$headers$`cache-control` + ) cache$change_age <- as.numeric(Sys.time()) content_length <- head_result$headers$`content-length` - pin_log("Checking 'etag' (old, new): ", old_cache$etag, ", ", cache$etag) + pin_log( + "Checking 'etag' (old, new): ", + old_cache$etag, + ", ", + cache$etag + ) } } - etag_changed <- is.null(cache$etag) || !identical(old_cache$etag, cache$etag) + etag_changed <- is.null(cache$etag) || + !identical(old_cache$etag, cache$etag) # skip downloading if etag has not changed if (old_cache_missing || etag_changed || must_download) { - if (identical(download_name, NULL)) download_name <- basename(path) + if (identical(download_name, NULL)) { + download_name <- basename(path) + } - if (remove_query) download_name <- strsplit(download_name, "\\?")[[1]][1] + if (remove_query) { + download_name <- strsplit(download_name, "\\?")[[1]][1] + } destination_path <- file.path(temp_path, download_name) pin_log("Downloading ", path, " to ", destination_path) details$something_changed <- TRUE write_spec <- httr::write_disk(destination_path, overwrite = TRUE) - result <- catch_error(httr::GET(path, write_spec, headers, config, http_utils_progress(size = content_length))) - extract_type <- gsub("application/(x-)?", "", result$headers$`content-type`) - if (!is.null(result$headers$`content-type`) && result$headers$`content-type` %in% c("application/octet-stream", "application/zip")) { - if (file.size(destination_path) > 4 && - identical(readBin(destination_path, raw(), 4), as.raw(c(0x50, 0x4b, 0x03, 0x04)))) { + result <- catch_error(httr::GET( + path, + write_spec, + headers, + config, + http_utils_progress(size = content_length) + )) + extract_type <- gsub( + "application/(x-)?", + "", + result$headers$`content-type` + ) + if ( + !is.null(result$headers$`content-type`) && + result$headers$`content-type` %in% + c("application/octet-stream", "application/zip") + ) { + if ( + file.size(destination_path) > 4 && + identical( + readBin(destination_path, raw(), 4), + as.raw(c(0x50, 0x4b, 0x03, 0x04)) + ) + ) { extract_type <- "zip" } } if (httr::http_error(result)) { - error <- paste0(httr::http_status(result)$message, ". Failed to download remote file: ", path) + error <- paste0( + httr::http_status(result)$message, + ". Failed to download remote file: ", + path + ) pin_log(as.character(httr::content(result, encoding = "UTF-8"))) report_error(error) @@ -206,7 +267,13 @@ pin_extract.gzip <- function(file, destination) { if (length(find.package("R.utils", quiet = TRUE)) == 0) { warning("To extract gzip pins install the 'R.utils' package") } else { - R.utils::gunzip(file, destname = file.path(destination, gsub(".gz", "", basename(file), fixed = TRUE))) + R.utils::gunzip( + file, + destname = file.path( + destination, + gsub(".gz", "", basename(file), fixed = TRUE) + ) + ) } } diff --git a/R/legacy_pin_manifest.R b/R/legacy_pin_manifest.R index d8abef409..0dd577da9 100644 --- a/R/legacy_pin_manifest.R +++ b/R/legacy_pin_manifest.R @@ -8,7 +8,9 @@ pin_manifest_get <- function(path) { manifest <- suppressWarnings(yaml::read_yaml(data_txt, eval.expr = FALSE)) } - if (is.null(manifest$type)) manifest$type <- "files" + if (is.null(manifest$type)) { + manifest$type <- "files" + } manifest } @@ -26,9 +28,12 @@ pin_manifest_exists <- function(path) { } pin_manifest_create <- function(path, metadata, files) { - entries <- c(list( - path = files - ), metadata) + entries <- c( + list( + path = files + ), + metadata + ) entries[sapply(entries, is.null)] <- NULL @@ -61,17 +66,18 @@ pin_manifest_download <- function(path, namemap = FALSE) { } mapped - } - else { + } else { downloads } } pin_manifest_merge <- function(base_manifest, resource_manifest) { # path requires special merge - if (!is.null(resource_manifest$path) && - !is.null(base_manifest$path) && - !grepl("https?://", base_manifest$path)) { + if ( + !is.null(resource_manifest$path) && + !is.null(base_manifest$path) && + !grepl("https?://", base_manifest$path) + ) { base_manifest$path <- file.path(base_manifest$path, resource_manifest$path) } diff --git a/R/legacy_pin_registry.R b/R/legacy_pin_registry.R index 50565f091..49f663245 100644 --- a/R/legacy_pin_registry.R +++ b/R/legacy_pin_registry.R @@ -139,7 +139,11 @@ pin_registry_path <- function(board, ...) { # I think this is used so that the rsconnect board can match x to any user pin_registry_qualify_name <- function(name, entries) { - name_pattern <- if (grepl("/", name)) paste0("^", name, "$") else paste0(".*/", name, "$") + name_pattern <- if (grepl("/", name)) { + paste0("^", name, "$") + } else { + paste0(".*/", name, "$") + } name_candidate <- names(entries)[grepl(name_pattern, names(entries))] if (length(name_candidate) == 1) { diff --git a/R/legacy_s3.R b/R/legacy_s3.R index b8c9708a0..aadfd73be 100644 --- a/R/legacy_s3.R +++ b/R/legacy_s3.R @@ -39,9 +39,15 @@ legacy_s3 <- function( name = "s3", ... ) { - if (nchar(bucket) == 0) stop("The 's3' board requires a 'bucket' parameter.") - if (nchar(key) == 0) stop("The 's3' board requires a 'key' parameter.") - if (nchar(secret) == 0) stop("The 's3' board requires a 'secret' parameter.") + if (nchar(bucket) == 0) { + stop("The 's3' board requires a 'bucket' parameter.") + } + if (nchar(key) == 0) { + stop("The 's3' board requires a 'key' parameter.") + } + if (nchar(secret) == 0) { + stop("The 's3' board requires a 'secret' parameter.") + } legacy_datatxt( name = name, diff --git a/R/legacy_test.R b/R/legacy_test.R index 22890c22d..4cfee866c 100644 --- a/R/legacy_test.R +++ b/R/legacy_test.R @@ -11,10 +11,13 @@ #' #' @keywords internal #' @export -board_test <- function(board, - exclude = list(), - suite = c("default", "versions")) { - suite <- switch(arg_match(suite), +board_test <- function( + board, + exclude = list(), + suite = c("default", "versions") +) { + suite <- switch( + arg_match(suite), default = board_test_default, versions = board_test_versions ) @@ -63,7 +66,9 @@ board_test_default <- function(board, exclude) { }) testthat::test_that(paste("can pin_remove() file from", name), { - if ("remove" %in% exclude) testthat::succeed() + if ("remove" %in% exclude) { + testthat::succeed() + } result <- pin_remove(pin_name, board = board) testthat::expect_equal(result, NULL) @@ -73,7 +78,9 @@ board_test_default <- function(board, exclude) { }) testthat::test_that(paste("can pin_remove() dataset from", name), { - if ("remove" %in% exclude) testthat::succeed() + if ("remove" %in% exclude) { + testthat::succeed() + } result <- pin_remove(dataset_name, board = board) testthat::expect_equal(result, NULL) @@ -101,25 +108,39 @@ board_test_versions <- function(board, exclude, name) { testthat::expect_gte(length(versions$version), 2) testthat::expect_equal( - as.character(pin_get(pin_name, version = versions$version[length(versions$version)], board = board)), + as.character(pin_get( + pin_name, + version = versions$version[length(versions$version)], + board = board + )), as.character(version_a) ) testthat::expect_equal( - as.character(pin_get(pin_name, version = versions$version[length(versions$version) - 1], board = board)), + as.character(pin_get( + pin_name, + version = versions$version[length(versions$version) - 1], + board = board + )), as.character(version_b) ) }) testthat::test_that(paste("can pin_remove() a pin with versions", name), { - if ("remove" %in% exclude) testthat::skip("This test is in the excluded list") + if ("remove" %in% exclude) { + testthat::skip("This test is in the excluded list") + } result <- pin_remove(pin_name, board = board) testthat::expect_equal(result, NULL) results <- pin_find(name = pin_name, board = board) if (nrow(results) > 0) { - testthat::fail(paste0("Pin '", paste(results$name, collapse = ","), "' still exists after removal.")) + testthat::fail(paste0( + "Pin '", + paste(results$name, collapse = ","), + "' still exists after removal." + )) } }) } diff --git a/R/meta.R b/R/meta.R index ea0aff026..a270dc68b 100644 --- a/R/meta.R +++ b/R/meta.R @@ -32,12 +32,14 @@ write_meta <- function(x, path) { # pin metadata ------------------------------------------------------------ -standard_meta <- function(paths, - type, - title = NULL, - description = NULL, - tags = NULL, - urls = NULL) { +standard_meta <- function( + paths, + type, + title = NULL, + description = NULL, + tags = NULL, + urls = NULL +) { list( file = fs::path_file(paths), file_size = as.integer(fs::file_size(paths)), @@ -89,15 +91,16 @@ default_title <- function(name, data = NULL, path = NULL) { } friendly_type <- function(x) { - switch(typeof(x), - logical = "logical vector", - integer = "integer vector", - numeric = , - double = "double vector", - complex = "complex vector", - character = "character vector", - raw = "raw vector", - list = "list", - typeof(x) + switch( + typeof(x), + logical = "logical vector", + integer = "integer vector", + numeric = , + double = "double vector", + complex = "complex vector", + character = "character vector", + raw = "raw vector", + list = "list", + typeof(x) ) } diff --git a/R/pin-meta.R b/R/pin-meta.R index aa55246a9..884564927 100644 --- a/R/pin-meta.R +++ b/R/pin-meta.R @@ -71,7 +71,10 @@ multi_meta <- function(board, names) { type = map_chr(meta, ~ .x$type %||% NA_character_), title = map_chr(meta, ~ .x$title %||% NA_character_), created = .POSIXct(map_dbl(meta, ~ .x$created %||% NA_real_)), - file_size = fs::as_fs_bytes(map_dbl(meta, ~ sum(.x$file_size %||% NA_real_))), + file_size = fs::as_fs_bytes(map_dbl( + meta, + ~ sum(.x$file_size %||% NA_real_) + )), meta = meta ) } @@ -98,7 +101,15 @@ empty_local_meta <- local_meta(x = NULL, name = NULL, dir = NULL) test_api_meta <- function(board) { testthat::test_that("can round-trip pin metadata", { - name <- local_pin(board, 1, title = "title", description = "desc", metadata = list(a = "a"), tags = c("tag1", "tag2"), urls = "https://posit.co/") + name <- local_pin( + board, + 1, + title = "title", + description = "desc", + metadata = list(a = "a"), + tags = c("tag1", "tag2"), + urls = "https://posit.co/" + ) meta <- pin_meta(board, name) testthat::expect_equal(meta$name, name) testthat::expect_equal(meta$title, "title") @@ -109,15 +120,22 @@ test_api_meta <- function(board) { }) testthat::test_that("can update pin metadata", { - mock_version_name <- - mockery::mock( - "20130104T050607Z-xxxxx", - "20130204T050607Z-yyyyy" - ) - testthat::local_mocked_bindings(version_name = mock_version_name) + mock_version_name <- + mockery::mock( + "20130104T050607Z-xxxxx", + "20130204T050607Z-yyyyy" + ) + testthat::local_mocked_bindings(version_name = mock_version_name) # RSC requires at least 3 characters name <- local_pin(board, 1, title = "xxx-a1", description = "xxx-a2") - pin_write(board, 1, name, title = "xxx-b1", description = "xxx-b2", force_identical_write = TRUE) + pin_write( + board, + 1, + name, + title = "xxx-b1", + description = "xxx-b2", + force_identical_write = TRUE + ) meta <- pin_meta(board, name) testthat::expect_equal(meta$title, "xxx-b1") @@ -148,7 +166,6 @@ test_api_meta <- function(board) { testthat::expect_vector(meta$user, list()) testthat::expect_vector(meta$local, list()) }) - } #' @export diff --git a/R/pin-store-fetch.R b/R/pin-store-fetch.R index ac1ee3ad7..abdbc977b 100644 --- a/R/pin-store-fetch.R +++ b/R/pin-store-fetch.R @@ -20,7 +20,15 @@ pin_fetch <- function(board, name, version = NULL, ...) { #' @export #' @rdname pin_fetch #' @inherit pin_upload -pin_store <- function(board, name, paths, metadata, versioned = NULL, x = NULL, ...) { +pin_store <- function( + board, + name, + paths, + metadata, + versioned = NULL, + x = NULL, + ... +) { check_dots_used() UseMethod("pin_store") } diff --git a/R/pin-upload-download.R b/R/pin-upload-download.R index 3fd5e88a6..80a1f6a3d 100644 --- a/R/pin-upload-download.R +++ b/R/pin-upload-download.R @@ -28,22 +28,25 @@ pin_download <- function(board, name, version = NULL, hash = NULL, ...) { #' @export #' @rdname pin_download #' @param paths A character vector of file paths to upload to `board`. -pin_upload <- function(board, - paths, - name = NULL, - ..., - title = NULL, - description = NULL, - metadata = NULL, - tags = NULL, - urls = NULL) { +pin_upload <- function( + board, + paths, + name = NULL, + ..., + title = NULL, + description = NULL, + metadata = NULL, + tags = NULL, + urls = NULL +) { check_board(board, "pin_upload", "pin") dots <- list2(...) if (!missing(...) && (is.null(names(dots)) || names(dots)[[1]] == "")) { - cli::cli_abort('Arguments after the dots `...` must be named, like {.code tags = "my-great-tag"}.') + cli::cli_abort( + 'Arguments after the dots `...` must be named, like {.code tags = "my-great-tag"}.' + ) } - if (!is.character(paths)) { abort("`path` must be a character vector") } @@ -67,7 +70,12 @@ pin_upload <- function(board, is_dir <- fs::is_dir(paths) if (any(is_dir)) { paths <- as.list(paths) - paths[is_dir] <- map(paths[is_dir], fs::dir_ls, recurse = TRUE, type = c("file", "symlink")) + paths[is_dir] <- map( + paths[is_dir], + fs::dir_ls, + recurse = TRUE, + type = c("file", "symlink") + ) paths <- as.character(unlist(paths, use.names = FALSE)) } diff --git a/R/pin.R b/R/pin.R index d5abd0ed7..077ae8724 100644 --- a/R/pin.R +++ b/R/pin.R @@ -137,7 +137,9 @@ check_store_zip <- function(zip) { #' @keywords internal #' @export pin.default <- function(x, name = NULL, description = NULL, board = NULL, ...) { - if (is.null(name)) name <- pin_default_name(deparse(substitute(x)), board) + if (is.null(name)) { + name <- pin_default_name(deparse(substitute(x)), board) + } path <- tempfile() dir.create(path) @@ -327,17 +329,22 @@ pin_default_name <- function(x, board) { name <- basename(x) error <- "Can't auto-generate pin name from object, please specify the 'name' parameter." - if (length(name) != 1) stop(error) + if (length(name) != 1) { + stop(error) + } sanitized <- gsub("[^a-zA-Z0-9-]", "-", name) sanitized <- gsub("^-*|-*$", "", sanitized) sanitized <- gsub("-+", "-", sanitized) - if (nchar(sanitized) == 0) stop(error) + if (nchar(sanitized) == 0) { + stop(error) + } # kaggle boards require five or more character names - if (identical(board, "kaggle") && nchar(sanitized) < 5) + if (identical(board, "kaggle") && nchar(sanitized) < 5) { sanitized <- paste(sanitized, "pin", sep = "-") + } sanitized } diff --git a/R/pin_info.R b/R/pin_info.R index 766cf3225..c68d8e944 100644 --- a/R/pin_info.R +++ b/R/pin_info.R @@ -57,8 +57,9 @@ pin_info <- function( entry_ext <- as.list(entry) entry_ext$metadata <- NULL entry_ext <- Filter( - function(e) - !is.list(e) || length(e) != 1 || !is.list(e[[1]]) || length(e[[1]]) > 0, + function(e) { + !is.list(e) || length(e) != 1 || !is.list(e[[1]]) || length(e[[1]]) > 0 + }, entry_ext ) for (name in names(metadata)) { @@ -82,10 +83,12 @@ print.pin_info <- function(x, ...) { info$type, "]\n" ))) - if (nchar(info$description) > 0) + if (nchar(info$description) > 0) { cat(cli::col_silver(paste0("# Description: ", info$description, "\n"))) - if (!is.null(info$signature)) + } + if (!is.null(info$signature)) { cat(cli::col_silver(paste0("# Signature: ", info$signature, "\n"))) + } info$board <- info$name <- info$type <- info$description <- info$signature <- NULL diff --git a/R/pin_versions.R b/R/pin_versions.R index c2a39f127..04b5595fe 100644 --- a/R/pin_versions.R +++ b/R/pin_versions.R @@ -95,14 +95,16 @@ pin_versions_prune <- function(board, name, n = NULL, days = NULL, ...) { if (!all(keep)) { to_delete <- versions$version[!keep] - pins_inform(paste0("Deleting versions: ", paste0(to_delete, collapse = ", "))) + pins_inform(paste0( + "Deleting versions: ", + paste0(to_delete, collapse = ", ") + )) for (version in to_delete) { pin_version_delete(board, name, version, ...) } } else { pins_inform("No old versions to delete") } - } versions_keep <- function(created, n = NULL, days = NULL) { @@ -156,22 +158,29 @@ version_from_path <- function(x) { out } -version_setup <- function(board, name, new_version, versioned = NULL, call = caller_env()) { - +version_setup <- function( + board, + name, + new_version, + versioned = NULL, + call = caller_env() +) { n_versions <- 0 - + if (pin_exists(board, name)) { versions <- pin_versions(board, name) n_versions <- nrow(versions) - + if (n_versions > 0) { old_version <- versions$version[[1]] if (old_version == new_version) { - cli::cli_abort(c( - "The new version {.val {new_version}} is the same as the most recent version.", - i = "Did you try to create a new version with the same timestamp as the last version?" - ), - call = call) + cli::cli_abort( + c( + "The new version {.val {new_version}} is the same as the most recent version.", + i = "Did you try to create a new version with the same timestamp as the last version?" + ), + call = call + ) } } } @@ -188,4 +197,4 @@ version_setup <- function(board, name, new_version, versioned = NULL, call = cal } new_version -} \ No newline at end of file +} diff --git a/R/testthat.R b/R/testthat.R index bad8f7132..58ad6f10f 100644 --- a/R/testthat.R +++ b/R/testthat.R @@ -15,7 +15,11 @@ skip_if_missing_envvars <- function(tests, envvars) { return() } - testthat::skip(paste0(tests, " tests require ", paste0(envvars, collapse = ", "))) + testthat::skip(paste0( + tests, + " tests require ", + paste0(envvars, collapse = ", ") + )) } # These functions are used to test families of invariants that apply to the @@ -114,7 +118,6 @@ test_api_basic <- function(board) { testthat::test_that("can find board required pkgs", { testthat::expect_snapshot(required_pkgs(board)) }) - } test_api_versioning <- function(board) { @@ -189,7 +192,6 @@ test_api_versioning <- function(board) { class = "pins_pin_versioned" ) }) - } test_api_manifest <- function(board) { @@ -206,7 +208,6 @@ test_api_manifest <- function(board) { class = "pins_pin_missing" ) }) - } local_httpbin_app <- function() { @@ -220,11 +221,14 @@ local_httpbin_app <- function() { # errors live here for now since they're closely bound to the tests abort_pin_missing <- function(name, call = caller_env()) { - cli_abort(c( - "Can't find pin called {.val {name}}", - i = "Use {.fun pin_list} to see all available pins in this board" - ), - class = "pins_pin_missing", call = call) + cli_abort( + c( + "Can't find pin called {.val {name}}", + i = "Use {.fun pin_list} to see all available pins in this board" + ), + class = "pins_pin_missing", + call = call + ) } abort_pin_version_missing <- function(version, call = caller_env()) { @@ -236,12 +240,13 @@ abort_pin_version_missing <- function(version, call = caller_env()) { } abort_pin_versioned <- function(call = caller_env()) { - cli_abort(c( - "Pin is versioned, but you have requested a write without versions", - i = "To un-version a pin, you must delete it" - ), - class = "pins_pin_versioned", - call = call + cli_abort( + c( + "Pin is versioned, but you have requested a write without versions", + i = "To un-version a pin, you must delete it" + ), + class = "pins_pin_versioned", + call = call ) } diff --git a/R/utils.R b/R/utils.R index 61f0c74f1..8988ccee8 100644 --- a/R/utils.R +++ b/R/utils.R @@ -11,7 +11,9 @@ http_utils_progress <- function( } pins_show_progress <- function(size, is_interactive) { - if (is.character(size)) size <- as.integer(size) + if (is.character(size)) { + size <- as.integer(size) + } is_interactive && getOption("pins.progress", TRUE) && @@ -133,7 +135,7 @@ is_rcmd_check <- function() { # adapted from ps:::is_cran_check() # nocov start -is_cran_check <- function () { +is_cran_check <- function() { if (identical(Sys.getenv("NOT_CRAN"), "true")) { FALSE } else { diff --git a/R/versions.R b/R/versions.R index 9255de8ac..9ebce1b61 100644 --- a/R/versions.R +++ b/R/versions.R @@ -3,7 +3,9 @@ pin_versions_path_name <- function() { } pin_version_signature <- function(hash_files) { - signature <- sapply(hash_files, function(x) digest::digest(x, algo = "sha1", file = TRUE)) + signature <- sapply(hash_files, function(x) { + digest::digest(x, algo = "sha1", file = TRUE) + }) if (length(signature) > 1) { signature <- paste(signature, collapse = ",") @@ -19,11 +21,18 @@ pin_versions_path <- function(storage_path) { version <- pin_version_signature(hash_files) - normalizePath(file.path(normalizePath(storage_path), pin_versions_path_name(), version), mustWork = FALSE) + normalizePath( + file.path(normalizePath(storage_path), pin_versions_path_name(), version), + mustWork = FALSE + ) } board_versions_enabled <- function(board, default = FALSE) { - if (default) !identical(board$versions, FALSE) else identical(board$versions, TRUE) + if (default) { + !identical(board$versions, FALSE) + } else { + identical(board$versions, TRUE) + } } board_versions_create <- function(board, name, path) { @@ -42,7 +51,9 @@ board_versions_create <- function(board, name, path) { versions <- versions[versions != version_relative] } - if (dir.exists(version_path)) unlink(version_path, recursive = TRUE) + if (dir.exists(version_path)) { + unlink(version_path, recursive = TRUE) + } dir.create(version_path, recursive = TRUE) files <- dir(path, full.names = TRUE) @@ -104,7 +115,11 @@ board_versions_expand <- function(versions, version) { version_index <- which(shortened == version) if (length(version_index) == 0) { - stop("Version '", version, "' is not valid, please select from pin_versions().") + stop( + "Version '", + version, + "' is not valid, please select from pin_versions()." + ) } versions[version_index] diff --git a/tests/testthat/test-board_connect.R b/tests/testthat/test-board_connect.R index 010518f56..092abdc1b 100644 --- a/tests/testthat/test-board_connect.R +++ b/tests/testthat/test-board_connect.R @@ -83,19 +83,18 @@ test_that("can create and delete content", { board <- board_connect_test() rsc_content_create(board, "test-1", list()) - expect_snapshot(error = TRUE, - rsc_content_create(board, "test-1", list()) - ) + expect_snapshot(error = TRUE, rsc_content_create(board, "test-1", list())) rsc_content_delete(board, paste0(board$account, "/test-1")) - expect_snapshot(error = TRUE, - rsc_content_delete(board, "test-1") - ) + expect_snapshot(error = TRUE, rsc_content_delete(board, "test-1")) }) test_that("can parse user & pin name", { expect_equal(rsc_parse_name("x"), list(owner = NULL, name = "x", full = NULL)) - expect_equal(rsc_parse_name("y/x"), list(owner = "y", name = "x", full = "y/x")) + expect_equal( + rsc_parse_name("y/x"), + list(owner = "y", name = "x", full = "y/x") + ) }) test_that("can find cached versions", { @@ -109,7 +108,10 @@ test_that("can find cached versions", { pin_write(board, 2, name) # Cached version hasn't changed since we haven't read - expect_message(expect_equal(rsc_content_version_cached(board, guid), cached_v)) + expect_message(expect_equal( + rsc_content_version_cached(board, guid), + cached_v + )) }) test_that("rsc_path() always includes leading /", { diff --git a/tests/testthat/test-board_connect_bundle.R b/tests/testthat/test-board_connect_bundle.R index 5f79ac95c..ea8e391c8 100644 --- a/tests/testthat/test-board_connect_bundle.R +++ b/tests/testthat/test-board_connect_bundle.R @@ -34,7 +34,12 @@ test_that("generates index files", { api_version = "1.0", user = list(my_meta = "User defined metadata") ) - expect_snapshot_output(cat(rsc_bundle_preview_index(board, "test", df, metadata))) + expect_snapshot_output(cat(rsc_bundle_preview_index( + board, + "test", + df, + metadata + ))) }) test_that("generates preview data", { diff --git a/tests/testthat/test-board_connect_server.R b/tests/testthat/test-board_connect_server.R index 3dd8aecb9..d7fe37eef 100644 --- a/tests/testthat/test-board_connect_server.R +++ b/tests/testthat/test-board_connect_server.R @@ -23,14 +23,15 @@ test_that("auth='auto' picks appropriate method and error if none found", { }) - # rsc_server_rsconnect ---------------------------------------------------- test_that("delivers useful messages if can't find RSC account", { mockery::stub(rsc_server_rsconnect, "rsconnect::accounts", NULL) expect_snapshot(rsc_server_rsconnect(), error = TRUE) - mockery::stub(rsc_server_rsconnect, "rsconnect::accounts", + mockery::stub( + rsc_server_rsconnect, + "rsconnect::accounts", data.frame(server = c("a", "b"), account = c("h", "g")) ) expect_snapshot(rsc_server_rsconnect(), error = TRUE) @@ -43,8 +44,14 @@ test_that("server url is normalised", { ref <- "http://example.com/test" expect_equal(rsc_server_manual("http://example.com/test", "")$url, ref) expect_equal(rsc_server_manual("http://example.com/test/", "")$url, ref) - expect_equal(rsc_server_manual("http://example.com/test/__api__", "")$url, ref) - expect_equal(rsc_server_manual("http://example.com/test/__api__/", "")$url, ref) + expect_equal( + rsc_server_manual("http://example.com/test/__api__", "")$url, + ref + ) + expect_equal( + rsc_server_manual("http://example.com/test/__api__/", "")$url, + ref + ) }) test_that("auth is hidden", { @@ -62,4 +69,3 @@ test_that("clearly errors if env vars missing", { expect_snapshot(rsc_server("envvar"), error = TRUE) expect_snapshot(rsc_server("envvar", server = "", key = ""), error = TRUE) }) - diff --git a/tests/testthat/test-board_folder.R b/tests/testthat/test-board_folder.R index deb543f65..d6f5107cb 100644 --- a/tests/testthat/test-board_folder.R +++ b/tests/testthat/test-board_folder.R @@ -31,10 +31,14 @@ test_that("can browse", { b <- board_folder(withr::local_tempfile()) b |> pin_write(1:10, "x") - expect_snapshot({ - b |> pin_browse("x") - b |> pin_browse("x", local = TRUE) - }, error = TRUE, transform = ~ gsub("<.*>", "", .x)) + expect_snapshot( + { + b |> pin_browse("x") + b |> pin_browse("x", local = TRUE) + }, + error = TRUE, + transform = ~ gsub("<.*>", "", .x) + ) }) test_that("can deparse", { @@ -81,7 +85,7 @@ test_that("generates useful messages", { "20130204T050607Z-yyyyy", "20130304T050607Z-zzzzz" ) - local_mocked_bindings(version_name = mock_version_name) + local_mocked_bindings(version_name = mock_version_name) ui_loud() b <- board_temp() diff --git a/tests/testthat/test-board_s3.R b/tests/testthat/test-board_s3.R index 2d016342b..ce27f6244 100644 --- a/tests/testthat/test-board_s3.R +++ b/tests/testthat/test-board_s3.R @@ -8,4 +8,3 @@ test_that("can deparse", { board <- board_s3_test() expect_snapshot(board_deparse(board)) }) - diff --git a/tests/testthat/test-board_url.R b/tests/testthat/test-board_url.R index 555adc6a1..e48effcca 100644 --- a/tests/testthat/test-board_url.R +++ b/tests/testthat/test-board_url.R @@ -148,7 +148,6 @@ test_that("pin_meta() works for versioned board", { b2 |> pin_meta("y", version = versions$version[[1]]), "pins_meta" ) - }) test_that("useful error for missing or unparseable manifest file", { @@ -175,7 +174,6 @@ test_that("useful error for missing or unparseable manifest file", { board_url(b4$url()), "Failed to parse manifest file at URL" ) - }) test_that("useful errors for unsupported methods", {