Merge pull request #434 from Bisaloo/20240710-lintr

Fix some suboptimal patterns identified by lintr

DESCRIPTION

@@ -26,7 +26,8 @@ Authors@R: c(person("Jason", "Becker", role = "aut", email = "[email protected]")
                     role="ctb",
                     comment=c(ORCID="0000-0002-5759-428X")),
              person("Alex", "Bokov", email = "[email protected]", role = "ctb",
-                    comment=c(ORCID="0000-0002-0511-9815"))
+                    comment=c(ORCID="0000-0002-0511-9815")),
+             person("Hugo", "Gruson", role = "ctb", comment = c(ORCID = "0000-0002-4094-1476"))
              )
 Description: Streamlined data import and export by making assumptions that
     the user is probably willing to make: 'import()' and 'export()' determine

R/compression.R

@@ -60,12 +60,10 @@ compress_out <- function(cfile, filename, type = c("zip", "tar", "tar.gz", "tar.
     if (type == "tar.bz2") {
         o <- utils::tar(cfile2, files = basename(filename), compression = "bzip2")
     }
-    setwd(wd)
     if (o != 0) {
         stop(sprintf("File compression failed for %s!", cfile))
     }
     file.copy(from = file.path(tmp, cfile2), to = cfile, overwrite = TRUE)
-    unlink(file.path(tmp, cfile2))
     return(cfile)
 }
 

R/export.R

@@ -106,7 +106,7 @@ export <- function(x, file, format, ...) {
     if (!is.data.frame(x) && !format %in% c("xlsx", "html", "rdata", "rds", "json", "qs", "fods", "ods")) {
         stop("'x' is not a data.frame or matrix", call. = FALSE)
     }
-    if (format %in% c("gz")) {
+    if (format == "gz") {
         format <- get_info(tools::file_path_sans_ext(file, compression = FALSE))$format
         if (format != "csv") {
             stop("gz is only supported for csv (for now).", call. = FALSE)

R/export_methods.R

@@ -82,13 +82,14 @@ export_delim <- function(file, x, fwrite = lifecycle::deprecated(), sep = "\t",
         message("Columns:")
         message(paste0(utils::capture.output(dict), collapse = "\n"))
         if (sep == "") {
-            message(paste0(
+            message(
                 "\nRead in with:\n",
                 'import("', file, '",\n',
                 "       widths = c(", paste0(n, collapse = ","), "),\n",
                 '       col.names = c("', paste0(names(n), collapse = '","'), '"),\n',
-                '       colClasses = c("', paste0(col_classes, collapse = '","'), '"))\n'
-            ), domain = NA)
+                '       colClasses = c("', paste0(col_classes, collapse = '","'), '"))\n',
+                domain = NA
+            )
         }
     }
     .write_as_utf8(paste0("#", utils::capture.output(utils::write.csv(dict, row.names = FALSE, quote = FALSE))), file = file, sep = "\n")
@@ -240,7 +241,6 @@ export_delim <- function(file, x, fwrite = lifecycle::deprecated(), sep = "\t",
 #' @export
 .export.rio_xml <- function(file, x, ...) {
     .check_pkg_availability("xml2")
-    root <- ""
     xml <- xml2::read_xml(paste0("<", as.character(substitute(x)), ">\n</", as.character(substitute(x)), ">\n"))
     att <- attributes(x)[!names(attributes(x)) %in% c("names", "row.names", "class")]
     for (a in seq_along(att)) {

R/extensions.R

@@ -12,7 +12,7 @@
                      fileinfo$format, fileinfo$import_function), call. = FALSE)
     }
     if (fileinfo$type == "enhance") {
-        pkg <- strsplit(fileinfo$import_function, "::")[[1]][1]
+        pkg <- strsplit(fileinfo$import_function, "::", fixed = TRUE)[[1]][1]
         stop(sprintf(gettext("Import support for the %s format is exported by the %s package. Run 'library(%s)' then try again."),
                      fileinfo$format, pkg, pkg), call. = FALSE)
     }

R/gather_attrs.R

@@ -19,7 +19,7 @@ gather_attrs <- function(x) {
         a <- attributes(x[[i]])
         varattrs[[i]] <- a[!names(a) %in% c("levels", "class")]
         attr(x[[i]], "label") <- NULL
-        if (any(grepl("labelled", class(x[[i]])))) {
+        if (any(grepl("labelled", class(x[[i]]), fixed = TRUE))) {
             x[[i]] <- haven::zap_labels(x[[i]])
         }
         f <- grep("^format", names(attributes(x[[i]])), value = TRUE)
@@ -28,7 +28,7 @@ gather_attrs <- function(x) {
         }
         rm(f)
     }
-    if (any(vapply(varattrs, length, integer(1)))) {
+    if (any(lengths(varattrs))) {
         attrnames <- sort(unique(unlist(lapply(varattrs, names))))
         outattrs <- stats::setNames(lapply(attrnames, function(z) {
             stats::setNames(lapply(varattrs, `[[`, z), names(x))

R/import.R

@@ -146,7 +146,6 @@ import <- function(file, format, setclass = getOption("rio.import.class", "data.
         ## format such as "|"
         format <- .standardize_format(format)
     }
-    args_list <- list(...)
     class(file) <- c(paste0("rio_", format), class(file))
     if (missing(which)) {
         x <- .import(file = file, ...)

R/import_list.R

@@ -52,9 +52,8 @@ import_list <- function(file, setclass = getOption("rio.import.class", "data.fra
             if (inherits(x2, "try-error")) {
                 warning("Attempt to rbindlist() the data did not succeed. List returned instead.", call. = FALSE)
                 return(x)
-            } else {
-                x <- x2
             }
+            x <- x2
         }
         x <- set_class(x, class = setclass)
     }

R/import_methods.R

@@ -322,10 +322,10 @@ import_delim <- function(file, which = 1, sep = "auto", header = "auto", strings
             out
         }
     }
-    if (!isTRUE(stringsAsFactors)) {
-        d[] <- lapply(d, tc2)
-    } else {
+    if (isTRUE(stringsAsFactors)) {
         d[] <- lapply(d, utils::type.convert)
+    } else {
+        d[] <- lapply(d, tc2)
     }
     d
 }
@@ -339,7 +339,7 @@ extract_html_row <- function(x, empty_value) {
     ## will be dropped and the table will not be generated).  Note that this more
     ## complex code for finding the length is required because of html like
     ## <td><br/></td>
-    unlist_length <- vapply(lapply(to_extract, unlist), length, integer(1))
+    unlist_length <- lengths(lapply(to_extract, unlist))
     to_extract[unlist_length == 0] <- list(empty_value)
     unlist(to_extract)
 }
@@ -349,12 +349,12 @@ extract_html_row <- function(x, empty_value) {
     # find all tables
     tables <- xml2::xml_find_all(xml2::read_html(unclass(file)), ".//table")
     if (which > length(tables)) {
-        stop(paste0("Requested table exceeds number of tables found in file (", length(tables), ")!"))
+        stop("Requested table exceeds number of tables found in file (", length(tables), ")!")
     }
     x <- xml2::as_list(tables[[which]])
     if ("tbody" %in% names(x)) {
         # Note that "tbody" may be specified multiple times in a valid html table
-        x <- unlist(x[names(x) %in% "tbody"], recursive = FALSE)
+        x <- unlist(x[names(x) == "tbody"], recursive = FALSE)
     }
     # loop row-wise over the table and then rbind()
     ## check for table header to use as column names

R/onLoad.R

@@ -3,7 +3,7 @@
         w <- uninstalled_formats()
         if (length(w)) {
             msg <- "The following rio suggested packages are not installed: %s\nUse 'install_formats()' to install them"
-            packageStartupMessage(sprintf(msg, paste0(sQuote(w), collapse = ", ")))
+            packageStartupMessage(sprintf(msg, toString(sQuote(w))))
         }
     }
 }

R/remote_to_local.R

@@ -1,5 +1,5 @@
 remote_to_local <- function(file, format) {
-    if (grepl("docs\\.google\\.com/spreadsheets", file)) {
+    if (grepl("docs.google.com/spreadsheets", file, fixed = TRUE)) {
         if (missing(format) || (!missing(format) && !format %in% c("csv", "tsv", "xlsx", "ods"))) {
             format <- "csv"
         }
@@ -32,13 +32,13 @@ remote_to_local <- function(file, format) {
     if (!any(grepl("^Content-Disposition", h1))) {
         stop("Unrecognized file format. Try specifying with the format argument.")
     }
-    h <- h1[grep("filename", h1)]
+    h <- h1[grep("filename", h1, fixed = TRUE)]
     if (length(h)) {
         f <- regmatches(h, regexpr("(?<=\")(.*)(?<!\")", h, perl = TRUE))
         if (!length(f)) {
             f <- regmatches(h, regexpr("(?<=filename=)(.*)", h, perl = TRUE))
         }
-        f <- paste0(dirname(temp_file), "/", f)
+        f <- file.path(dirname(temp_file), f)
         file.copy(from = temp_file, to = f)
         unlink(temp_file)
         return(f)

R/standardize_attributes.R

@@ -16,13 +16,13 @@ standardize_attributes <- function(dat) {
             attr(out[[i]], "labels") <- attr(out[[i]], "value.labels", exact = TRUE)
             attr(out[[i]], "value.labels") <- NULL
         }
-        if (any(grepl("haven_labelled", class(out[[i]])))) {
+        if (any(grepl("haven_labelled", class(out[[i]]), fixed = TRUE))) {
             out[[i]] <- unclass(out[[i]])
         }
         if ("var.labels" %in% names(a)) {
             attr(out[[i]], "label") <- a$var.labels[i]
         }
-        if (any(grepl("$format", names(a)))) {
+        if (any(grepl("$format", names(a), fixed = TRUE))) {
             attr(out[[i]], "format") <- a[[grep("$format", names(a))[1L]]][i]
         }
         if ("types" %in% names(a)) {

R/utils.R

@@ -120,7 +120,7 @@ escape_xml <- function(x, replacement = c("&amp;", "&quot;", "&lt;", "&gt;", "&a
         if (is.null(names_x)) {
             return(sprintf(file, seq_along(x)))
         }
-        if (any(nchar(names_x) == 0)) {
+        if (!all(nzchar(names_x))) {
             stop("All elements of 'x' must be named or all must be unnamed")
         }
         if (anyDuplicated(names_x)) {

vignettes/rio.Rmd

@@ -52,7 +52,7 @@ feature_table$import_function[is.na(feature_table$import_function)] <- ""
 feature_table$export_function <- stringi::stri_extract_first(feature_table$export_function, regex = "[a-zA-Z0-9\\.]+")
 feature_table$export_function[is.na(feature_table$export_function)] <- ""
 
-feature_table$type <- ifelse(feature_table$type %in% c("suggest"), "Suggest", "Default")
+feature_table$type <- ifelse(feature_table$type == "suggest", "Suggest", "Default")
 feature_table <- feature_table[,c("format_name", "signature", "import_function", "export_function", "type", "note")]
 
 colnames(feature_table) <- c("Name", "Extensions / \"format\"", "Import Package", "Export Package", "Type", "Note")