diff --git a/R/export_methods.R b/R/export_methods.R index c3aa6aa..bcee974 100644 --- a/R/export_methods.R +++ b/R/export_methods.R @@ -3,17 +3,9 @@ export_delim <- function(file, x, fwrite = lifecycle::deprecated(), sep = "\t", if (lifecycle::is_present(fwrite)) { lifecycle::deprecate_warn(when = "0.5.31", what = "export(fwrite)", details = "plain text files will always be written with `data.table::fwrite`. The parameter `fwrite` will be dropped in v2.0.0.") } - if (isTRUE(append)) { - data.table::fwrite(x, - file = file, sep = sep, row.names = row.names, - col.names = FALSE, append = TRUE, ... - ) - } else { - data.table::fwrite(x, - file = file, sep = sep, row.names = row.names, - col.names = col.names, append = FALSE, ... - ) - } + .docall(data.table::fwrite, ..., + args = list(x = x, file = file, sep = sep, row.names = row.names, + col.names = ifelse(append, FALSE, col.names), append = append)) } #' @export @@ -100,25 +92,24 @@ export_delim <- function(file, x, fwrite = lifecycle::deprecated(), sep = "\t", } } .write_as_utf8(paste0("#", utils::capture.output(utils::write.csv(dict, row.names = FALSE, quote = FALSE))), file = file, sep = "\n") - utils::write.table(dat, - file = file, append = TRUE, row.names = row.names, sep = sep, quote = quote, - col.names = col.names, ... - ) + .docall(utils::write.table, ..., + args = list(x = dat, file = file, append = TRUE, row.names = row.names, sep = sep, quote = quote, + col.names = col.names)) } #' @export .export.rio_r <- function(file, x, ...) { - dput(x, file = file, ...) + .docall(dput, ..., args = list(x = x, file = file)) } #' @export .export.rio_dump <- function(file, x, ...) { - dump(as.character(substitute(x)), file = file, ...) + dump(as.character(substitute(x)), file = file) } #' @export .export.rio_rds <- function(file, x, ...) { - saveRDS(object = x, file = file, ...) + .docall(saveRDS, ..., args = list(object = x, file = file)) } #' @export @@ -144,76 +135,76 @@ export_delim <- function(file, x, fwrite = lifecycle::deprecated(), sep = "\t", #' @export .export.rio_feather <- function(file, x, ...) { - arrow::write_feather(x = x, sink = file, ...) + .docall(arrow::write_feather, ..., args = list(x = x, sink = file)) } #' @export .export.rio_fst <- function(file, x, ...) { .check_pkg_availability("fst") - fst::write.fst(x = x, path = file, ...) + .docall(fst::write.fst, ..., args = list(x = x, path = file)) } #' @export .export.rio_matlab <- function(file, x, ...) { .check_pkg_availability("rmatio") - rmatio::write.mat(object = x, filename = file, ...) + .docall(rmatio::write.mat, ..., args = list(object = x, filename = file)) } #' @export .export.rio_sav <- function(file, x, ...) { x <- restore_labelled(x) - haven::write_sav(data = x, path = file, ...) + .docall(haven::write_sav, ..., args = list(data = x, path = file)) } #' @export .export.rio_zsav <- function(file, x, compress = TRUE, ...) { x <- restore_labelled(x) - haven::write_sav(data = x, path = file, compress = compress, ...) + .docall(haven::write_sav, ..., args = list(data = x, path = file, compress = compress)) } #' @export .export.rio_dta <- function(file, x, ...) { x <- restore_labelled(x) - haven::write_dta(data = x, path = file, ...) + .docall(haven::write_dta, ..., args = list(data = x, path = file)) } #' @export .export.rio_sas7bdat <- function(file, x, ...) { x <- restore_labelled(x) - haven::write_sas(data = x, path = file, ...) + .docall(haven::write_sas, ..., args = list(data = x, path = file)) } #' @export .export.rio_xpt <- function(file, x, ...) { x <- restore_labelled(x) - haven::write_xpt(data = x, path = file, ...) + .docall(haven::write_xpt, ..., args = list(data = x, path = file)) } #' @export .export.rio_dbf <- function(file, x, ...) { - foreign::write.dbf(dataframe = x, file = file, ...) + .docall(foreign::write.dbf, ..., args = list(dataframe = x, file = file)) } #' @export .export.rio_json <- function(file, x, ...) { .check_pkg_availability("jsonlite") - .write_as_utf8(jsonlite::toJSON(x, ...), file = file) + .write_as_utf8(.docall(jsonlite::toJSON, ..., args = list(x = x)), file = file) } #' @export .export.rio_arff <- function(file, x, ...) { - foreign::write.arff(x = x, file = file, ...) + .docall(foreign::write.arff, ..., args = list(x = x, file = file)) } #' @export .export.rio_xlsx <- function(file, x, ...) { - writexl::write_xlsx(x = x, path = file, ...) + .docall(writexl::write_xlsx, ..., args = list(x = x, path = file)) } #' @export .export.rio_ods <- function(file, x, ...) { .check_pkg_availability("readODS") - readODS::write_ods(x = x, path = file, ...) + .docall(readODS::write_ods, ..., args = list(x = x, path = file)) } #' @export @@ -237,7 +228,7 @@ export_delim <- function(file, x, fwrite = lifecycle::deprecated(), sep = "\t", xml2::xml_add_child(tab, xml2::read_xml(paste0(twrap(paste0(twrap(unlist(x[[i]][j, , drop = TRUE]), "td"), collapse = ""), "tr"), "\n"))) } } - xml2::write_xml(html, file = file, ...) + .docall(xml2::write_xml, ..., args = list(x = html, file = file)) } #' @export @@ -262,34 +253,34 @@ export_delim <- function(file, x, fwrite = lifecycle::deprecated(), sep = "\t", } } - xml2::write_xml(xml, file = file, ...) + .docall(xml2::write_xml, ..., args = list(x = xml, file = file)) } #' @export .export.rio_yml <- function(file, x, ...) { .check_pkg_availability("yaml") - yaml::write_yaml(x, file = file, ...) + .docall(yaml::write_yaml, ..., args = list(x = x, file = file)) } #' @export .export.rio_clipboard <- function(file, x, row.names = FALSE, col.names = TRUE, sep = "\t", ...) { .check_pkg_availability("clipr") - clipr::write_clip(content = x, row.names = row.names, col.names = col.names, sep = sep, ...) + .docall(clipr::write_clip, ..., args = list(content = x, row.names = row.names, col.names = col.names, sep = sep)) } #' @export .export.rio_pzfx <- function(file, x, ..., row_names = FALSE) { .check_pkg_availability("pzfx") - pzfx::write_pzfx(x = x, path = file, ..., row_names = row_names) + .docall(pzfx::write_pzfx, ..., args = list(x = x, path = file, row_names = row_names)) } #' @export .export.rio_parquet <- function(file, x, ...) { - arrow::write_parquet(x = x, sink = file, ...) + .docall(arrow::write_parquet, ..., args = list(x = x, sink = file)) } #' @export .export.rio_qs <- function(file, x, ...) { .check_pkg_availability("qs") - qs::qsave(x = x, file = file, ...) + .docall(qs::qsave, ..., args = list(x = x, file = file)) } diff --git a/R/fwf2.R b/R/fwf2.R index 98cccd7..00d8ab3 100644 --- a/R/fwf2.R +++ b/R/fwf2.R @@ -50,5 +50,5 @@ read.fwf2 <- function(file, widths, header = FALSE, sep = "\t", skip = 0, n = -1 } else { text <- vapply(raw, doone, character(1)) } - utils::read.table(text = text, header = header, sep = sep, quote = quote, stringsAsFactors = stringsAsFactors, ...) + .docall(utils::read.table, ..., args = list(text = text, header = header, sep = sep, quote = quote, stringsAsFactors = stringsAsFactors)) } diff --git a/R/import_methods.R b/R/import_methods.R index 5cc7cfa..32c0418 100644 --- a/R/import_methods.R +++ b/R/import_methods.R @@ -107,15 +107,12 @@ import_delim <- function(file, which = 1, sep = "auto", header = "auto", strings #' @export .import.rio_r <- function(file, which = 1, ...) { - dget(file = file, ...) + .docall(dget, ..., args = list(file = file)) } #' @export .import.rio_dump <- function(file, which = 1, envir = new.env(), ...) { source(file = file, local = envir) - if (length(list(...)) > 0) { - warning("File imported using load. Arguments to '...' ignored.") - } if (missing(which)) { if (length(ls(envir)) > 1) { warning("Dump file contains multiple objects. Returning first object.") @@ -131,18 +128,12 @@ import_delim <- function(file, which = 1, sep = "auto", header = "auto", strings #' @export .import.rio_rds <- function(file, which = 1, ...) { - if (length(list(...)) > 0) { - warning("File imported using readRDS. Arguments to '...' ignored.") - } readRDS(file = file) } #' @export .import.rio_rdata <- function(file, which = 1, envir = new.env(), ...) { load(file = file, envir = envir) - if (length(list(...)) > 0) { - warning("File imported using load. Arguments to '...' ignored.") - } if (missing(which)) { if (length(ls(envir)) > 1) { warning("Rdata file contains multiple objects. Returning first object.") @@ -161,13 +152,13 @@ import_delim <- function(file, which = 1, sep = "auto", header = "auto", strings #' @export .import.rio_feather <- function(file, which = 1, ...) { - arrow::read_feather(file = file, ...) + .docall(arrow::read_feather, ..., args = list(file = file)) } #' @export .import.rio_fst <- function(file, which = 1, ...) { .check_pkg_availability("fst") - fst::read.fst(path = file, ...) + .docall(fst::read.fst, ..., args = list(path = file)) } #' @export @@ -187,12 +178,12 @@ import_delim <- function(file, which = 1, sep = "auto", header = "auto", strings #' @export .import.rio_dbf <- function(file, which = 1, as.is = TRUE, ...) { - foreign::read.dbf(file = file, as.is = as.is) + .docall(foreign::read.dbf, ..., args = list(file = file, as.is = as.is)) } #' @export .import.rio_dif <- function(file, which = 1, ...) { - utils::read.DIF(file = file, ...) + .docall(utils::read.DIF, ..., args = list(file = file)) } #' @export @@ -200,22 +191,22 @@ import_delim <- function(file, which = 1, sep = "auto", header = "auto", strings if (lifecycle::is_present(haven) || lifecycle::is_present(to.data.frame) || lifecycle::is_present(use.value.labels)) { lifecycle::deprecate_warn(when = "0.5.31", what = "import(haven)", details = "sav will always be read by `haven`. The parameter `haven` will be dropped in v2.0.0.") } - standardize_attributes(haven::read_sav(file = file)) + standardize_attributes(.docall(haven::read_sav, ..., args = list(file = file))) } #' @export .import.rio_zsav <- function(file, which = 1, ...) { - standardize_attributes(haven::read_sav(file = file)) + standardize_attributes(.docall(haven::read_sav, ..., args = list(file = file))) } #' @export .import.rio_spss <- function(file, which = 1, ...) { - standardize_attributes(haven::read_por(file = file)) + standardize_attributes(.docall(haven::read_por, ..., args = list(file = file))) } #' @export .import.rio_sas7bdat <- function(file, which = 1, column.labels = FALSE, ...) { - standardize_attributes(haven::read_sas(data_file = file, ...)) + standardize_attributes(.docall(haven::read_sas, ..., args = list(data_file = file))) } #' @export @@ -223,33 +214,33 @@ import_delim <- function(file, which = 1, sep = "auto", header = "auto", strings if (lifecycle::is_present(haven)) { lifecycle::deprecate_warn(when = "0.5.31", what = "import(haven)", details = "xpt will always be read by `haven`. The parameter `haven` will be dropped in v2.0.0.") } - standardize_attributes(haven::read_xpt(file = file, ...)) + standardize_attributes(.docall(haven::read_xpt, ..., args = list(file = file))) } #' @export .import.rio_mtp <- function(file, which = 1, ...) { - foreign::read.mtp(file = file, ...) + .docall(foreign::read.mtp, ..., args = list(file = file)) } #' @export .import.rio_syd <- function(file, which = 1, ...) { - foreign::read.systat(file = file, to.data.frame = TRUE, ...) + .docall(foreign::read.systat, ..., args = list(file = file, to.data.frame = TRUE)) } #' @export .import.rio_json <- function(file, which = 1, ...) { .check_pkg_availability("jsonlite") - jsonlite::fromJSON(txt = file, ...) + .docall(jsonlite::fromJSON, ..., args = list(txt = file)) } #' @export .import.rio_rec <- function(file, which = 1, ...) { - foreign::read.epiinfo(file = file, ...) + .docall(foreign::read.epiinfo, ..., args = list(file = file)) } #' @export .import.rio_arff <- function(file, which = 1, ...) { - foreign::read.arff(file = file) + .docall(foreign::read.arff, ..., args = list(file = file)) } #' @export @@ -274,7 +265,7 @@ import_delim <- function(file, which = 1, sep = "auto", header = "auto", strings if (missing(style)) { stop("Import of Fortran format data requires a 'style' argument. See ? utils::read.fortran().") } - utils::read.fortran(file = file, format = style, ...) + .docall(utils::read.fortran, ..., args = list(file = file, format = style)) } #' @export @@ -358,19 +349,19 @@ extract_html_row <- function(x, empty_value) { #' @export .import.rio_yml <- function(file, which = 1, stringsAsFactors = FALSE, ...) { .check_pkg_availability("yaml") - as.data.frame(yaml::read_yaml(file, ...), stringsAsFactors = stringsAsFactors) + as.data.frame(.docall(yaml::read_yaml, ..., args = list(file = file)), stringsAsFactors = stringsAsFactors) } #' @export .import.rio_eviews <- function(file, which = 1, ...) { .check_pkg_availability("hexView") - hexView::readEViews(file, ...) + .docall(hexView::readEViews, ..., args = list(filename = file)) } #' @export .import.rio_clipboard <- function(file = "clipboard", which = 1, header = TRUE, sep = "\t", ...) { .check_pkg_availability("clipr") - clipr::read_clip_tbl(x = clipr::read_clip(), header = header, sep = sep, ...) + .docall(clipr::read_clip_tbl, ..., args = list(x = clipr::read_clip(), header = header, sep = sep)) } #' @export @@ -388,12 +379,12 @@ extract_html_row <- function(x, empty_value) { } #' @export -.import.rio_parquet <- function(file, which = 1, as_data_frame = TRUE, ...) { - arrow::read_parquet(file = file, as_data_frame = TRUE, ...) +.import.rio_parquet <- function(file, which = 1, ...) { + .docall(arrow::read_parquet, ..., args = list(file = file, as_data_frame = TRUE)) } #' @export .import.rio_qs <- function(file, which = 1, ...) { .check_pkg_availability("qs") - qs::qread(file = file, ...) + .docall(qs::qread, ..., args = list(file = file)) } diff --git a/tests/testthat/test_format_feather.R b/tests/testthat/test_format_feather.R index bbe6aec..cd895da 100644 --- a/tests/testthat/test_format_feather.R +++ b/tests/testthat/test_format_feather.R @@ -9,10 +9,4 @@ test_that("Import from feather", { expect_true(is.data.frame(import("iris.feather"))) }) -test_that("... correctly passed, #318", { - ## actually feather::write_feather has only two arguments (as of 2023-09-01) - ## it is more for possible future expansion - expect_error(export(mtcars, "mtcars.feather", hello = 42)) -}) - unlink("iris.feather") diff --git a/tests/testthat/test_format_rdata.R b/tests/testthat/test_format_rdata.R index 35f496c..22cc7ab 100644 --- a/tests/testthat/test_format_rdata.R +++ b/tests/testthat/test_format_rdata.R @@ -17,11 +17,6 @@ test_that("Export to Rdata", { test_that("Import from Rdata", { expect_true(is.data.frame(import("iris.Rdata"))) expect_true(is.data.frame(import("iris.Rdata", which = 1))) - expect_warning(is.data.frame(import("iris.Rdata",which=1, - verbose='ignored value', - invalid_argument=42)), - "File imported using load. Arguments to '...' ignored.", - label="RData imports and ignores unused arguments with a warning") }) test_that("Export to rda", { @@ -31,11 +26,6 @@ test_that("Export to rda", { test_that("Import from rda", { expect_true(is.data.frame(import("iris.rda"))) expect_true(is.data.frame(import("iris.rda", which = 1))) - expect_warning(is.data.frame(import("iris.rda", which=1, - verbose="ignored value", - invalid_argument=42)), - "File imported using load. Arguments to '...' ignored.", - label="rda imports and ignores unused arguments with a warning") }) unlink("iris.Rdata") diff --git a/tests/testthat/test_format_rds.R b/tests/testthat/test_format_rds.R index 51ee152..cd9b933 100644 --- a/tests/testthat/test_format_rds.R +++ b/tests/testthat/test_format_rds.R @@ -7,9 +7,6 @@ test_that("Export to rds", { test_that("Import from rds", { expect_true(is.data.frame(import("iris.rds"))) - expect_warning(import("iris.rds", invalid_argument=42), - "File imported using readRDS. Arguments to '...' ignored.", - label="rda imports and ignores unused arguments with a warning") }) test_that("Export to rds (non-data frame)", {