diff --git a/.Rbuildignore b/.Rbuildignore index 743c0ca0b..20c9bceb6 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -10,3 +10,4 @@ ^vignettes/articles$ ^LICENSE\.md$ ^blog$ +^_pkgdown\.yml$ diff --git a/R/board_datatxt.R b/R/board_datatxt.R index ac0a0e734..78655c590 100644 --- a/R/board_datatxt.R +++ b/R/board_datatxt.R @@ -108,7 +108,7 @@ datatxt_refresh_index <- function(board) { } fs::dir_create(fs::path_dir(local_index)) - yaml::write_yaml(current_index, local_index) + write_yaml(current_index, local_index) } @@ -527,7 +527,7 @@ board_manifest_load <- function(manifest) { } board_manifest_create <- function(index, file) { - yaml::write_yaml(index, file) + write_yaml(index, file) } pin_entries_to_dataframe <- function(entries) { diff --git a/R/board_github.R b/R/board_github.R index 594cfeac3..06a21ad2e 100644 --- a/R/board_github.R +++ b/R/board_github.R @@ -461,7 +461,7 @@ board_pin_create.pins_board_github <- function(board, path, name, metadata, ...) names(datatxt$filenames) <- datatxt$path - yaml::write_yaml(datatxt, file_path) + write_yaml(datatxt, file_path) } # create upload definition of remote-path/local-path diff --git a/R/board_local.R b/R/board_local.R index 987cf7538..14bea0ca3 100644 --- a/R/board_local.R +++ b/R/board_local.R @@ -58,7 +58,10 @@ board_browse.pins_board_local <- function(board, ...) { #' @export pin_list.pins_board_local <- function(board, ...) { - fs::path_file(fs::dir_ls(board$path, type = "directory")) + dir <- fs::dir_ls(board$path, type = "directory") + metadata <- fs::path(dir, "data.txt") + + fs::path_file(dir[fs::file_exists(metadata)]) } #' @export diff --git a/R/board_rsconnect.R b/R/board_rsconnect.R index 836217459..4565d06f7 100644 --- a/R/board_rsconnect.R +++ b/R/board_rsconnect.R @@ -539,7 +539,7 @@ read_cache <- function(path) { update_cache <- function(path, key, value) { cache <- read_cache(path) cache[[key]] <- value - yaml::write_yaml(cache, path) + write_yaml(cache, path) value } diff --git a/R/board_rsconnect_bundle.R b/R/board_rsconnect_bundle.R index 89cea9e3b..8cf7af775 100644 --- a/R/board_rsconnect_bundle.R +++ b/R/board_rsconnect_bundle.R @@ -6,7 +6,7 @@ rsc_bundle <- function(board, name, path, metadata, x = NULL, bundle_path = temp fs::file_copy(path, fs::path(bundle_path, fs::path_file(path))) # * data.txt (used to retrieve pins) - yaml::write_yaml(metadata, fs::path(bundle_path, "data.txt")) + write_yaml(metadata, fs::path(bundle_path, "data.txt")) # * index.html rsc_bundle_preview_create(board, name, metadata, path = bundle_path, x = x) diff --git a/R/meta.R b/R/meta.R index 3c8e7b22f..c72590487 100644 --- a/R/meta.R +++ b/R/meta.R @@ -22,7 +22,7 @@ read_meta <- function(path) { write_meta <- function(x, path) { path <- fs::path(path, "data.txt") - yaml::write_yaml(x, path) + write_yaml(x, path) } # pin metadata ------------------------------------------------------------ diff --git a/R/pin_manifest.R b/R/pin_manifest.R index c7a7314df..d8abef409 100644 --- a/R/pin_manifest.R +++ b/R/pin_manifest.R @@ -16,7 +16,7 @@ pin_manifest_get <- function(path) { pin_manifest_update <- function(path, manifest) { data_txt <- file.path(path, "data.txt") - manifest <- yaml::write_yaml(manifest, data_txt) + manifest <- write_yaml(manifest, data_txt) manifest } @@ -33,7 +33,7 @@ pin_manifest_create <- function(path, metadata, files) { entries[sapply(entries, is.null)] <- NULL fs::dir_create(path) - yaml::write_yaml(entries, file.path(path, "data.txt")) + write_yaml(entries, file.path(path, "data.txt")) } # retrieve a list of files to download diff --git a/R/pin_registry.R b/R/pin_registry.R index 851207bb2..2b1787a56 100644 --- a/R/pin_registry.R +++ b/R/pin_registry.R @@ -18,7 +18,7 @@ pin_registry_read <- function(board) { pin_registry_write <- function(board, entries) { stopifnot(is.board(board)) - yaml::write_yaml(unname(entries), pin_registry_path(board, "data.txt")) + write_yaml(unname(entries), pin_registry_path(board, "data.txt")) } # Lock registry file to prevent multi-process race conditions diff --git a/R/utils.R b/R/utils.R index f1eb4897f..3ff2cd614 100644 --- a/R/utils.R +++ b/R/utils.R @@ -66,3 +66,23 @@ ui_loud <- function() { } github_raw <- function(x) paste0("https://raw.githubusercontent.com/", x) + +write_yaml <- function(x, path) { + x <- to_utf8(x) + yaml::write_yaml(x, path) +} + +# On Windows, yaml::write_yaml() crashes with Latin1 data +# https://github.com/viking/r-yaml/issues/90 +to_utf8 <- function(x) { + if (is.list(x)) { + if (!is.null(names(x))) { + names(x) <- enc2utf8(names(x)) + } + lapply(x, to_utf8) + } else if (is.character(x)) { + enc2utf8(x) + } else { + x + } +} diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R new file mode 100644 index 000000000..e71a8cd78 --- /dev/null +++ b/tests/testthat/test-utils.R @@ -0,0 +1,13 @@ +test_that("write_yaml can write non-UTF8 data", { + str <- "fa\xE7ile" + Encoding(str) <- "latin1" + + x <- list(str) + names(x) <- str + + path <- tempfile() + write_yaml(x, path) + + y <- yaml::read_yaml(path) + expect_equal(y, list("fa\u00e7ile" = "fa\u00e7ile")) +})