Fix #458 (#461)

* Fix #458

The S3 method can be dispatched. But the problem is that it can't be
tested with testthat. Why?

* Make test work

* Reduce line count

* Simplify .standardize_format

Author: chainsawriot

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: rio
 Type: Package
 Title: A Swiss-Army Knife for Data I/O
-Version: 1.2.3
+Version: 1.2.4
 Authors@R: c(person("Jason", "Becker", role = "aut", email = "[email protected]"),
              person("Chung-hong", "Chan", role = c("aut", "cre"), email = "[email protected]",
 	     	     comment = c(ORCID = "0000-0002-6232-7530")),

NEWS.md

@@ -1,3 +1,9 @@
+# rio 1.2.4
+
+Bug fixes
+
+* Fix #458, custom S3 import and export functions work again
+
 # rio 1.2.3
 
 * Fix #453, don't nudge the user to install all suggested packages

R/extensions.R

@@ -3,8 +3,8 @@
 }
 
 .import.default <- function(file, ...) {
-    fileinfo <- get_info(file)
-    if (is.na(fileinfo$type) || is.na(fileinfo$import_function) || fileinfo$import_function == "") {
+    fileinfo <- get_info(file) ## S3 can't be dispatched
+    if (fileinfo$type == "unknown" || is.na(fileinfo$import_function) || fileinfo$import_function == "") {
         stop("Format not supported", call. = FALSE)
     }
     if (fileinfo$type == "known") {
@@ -24,7 +24,7 @@
 
 .export.default <- function(file, x, ...) {
     fileinfo <- get_info(file)
-    if (is.na(fileinfo$type) || is.na(fileinfo$export_function) || fileinfo$export_function == "") {
+    if (fileinfo$type == "unknown" || is.na(fileinfo$export_function) || fileinfo$export_function == "") {
         stop("Format not supported", call. = FALSE)
     }
     if (fileinfo$type == "known") {

R/utils.R

@@ -54,19 +54,15 @@ get_ext <- function(file) {
     ## TODO google sheets
     matched_formats <- unique_rio_formats[unique_rio_formats$input == input, ]
     if (nrow(matched_formats) == 0) {
-        return(list(input = input, format = NA, type = NA, format_name = NA, import_function = NA, export_function = NA, file = file))
+        return(list(input = input, format = input, type = "unknown", format_name = NA, import_function = NA, export_function = NA, file = file))
     }
     output <- as.list(matched_formats)
     output$file <- file
     return(output)
 }
 
 .standardize_format <- function(input) {
-    info <- .query_format(input, "")
-    if (is.na(info$format)) {
-        return(input)
-    }
-    info$format
+    .query_format(input, "")$format
 }
 
 twrap <- function(value, tag) {

tests/testthat/test_extensions.R

@@ -1,25 +1,30 @@
 library("datasets")
+skip_on_cran()
 
 test_that("S3 extension mechanism works for imports", {
     withr::with_tempdir({
         write.csv(iris, "iris.custom")
-        expect_error(import("iris.custom"))
+        expect_error(import("iris.custom"), "Format not supported")
         .import.rio_custom <- function(file, ...) {
             read.csv(file, ...)
         }
-        ##expect_true(is.data.frame(import('iris.custom')))
-        rm(.import.rio_custom)
+        expect_error(.import.rio_custom("iris.custom"), NA)
+        assign(".import.rio_custom", .import.rio_custom, envir = .GlobalEnv)
+        expect_true(is.data.frame(import("iris.custom")))
+        rm(list = ".import.rio_custom", envir = .GlobalEnv)
     })
 })
 
 test_that("S3 extension mechanism works for exports", {
     withr::with_tempdir({
-        expect_error(export("iris.custom"))
-        .export.rio_custom <- function(file, data, ...) {
-            write.csv(data, file, ...)
+        expect_error(export(iris, "iris.custom"))
+        .export.rio_custom <- function(file, x, ...) {
+            write.csv(x, file, ...)
             invisible(file)
         }
-        expect_error(is.character(export(iris, "iris.custom")))
-        rm(.export.rio_custom)
+        expect_error(.export.rio_custom("iris.custom", iris), NA)
+        assign(".export.rio_custom", .export.rio_custom, envir = .GlobalEnv)
+        expect_true(is.character(export(iris, "iris.custom")))
+        rm(list = ".export.rio_custom", envir = .GlobalEnv)
     })
 })