Wrap all calls with .docall

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))
 }

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))
 }

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,69 +178,69 @@ 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
 .import.rio_sav <- function(file, which = 1, haven = lifecycle::deprecated(), to.data.frame = lifecycle::deprecated(), use.value.labels = lifecycle::deprecated(), ...) {
     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
 .import.rio_xpt <- function(file, which = 1, haven = lifecycle::deprecated(), ...) {
     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))
 }

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")