Update tests + various lints

R/class-style_mgr.R

@@ -447,14 +447,14 @@ style_mgr <- R6::R6Class("wbStylesMgr", {
  typ <- NULL
  id <- NULL
 
- is_numfmt <- any(ifelse(xml_node_name(style[sty]) == "numFmt", TRUE, FALSE))
- is_font <- any(ifelse(xml_node_name(style[sty]) == "font", TRUE, FALSE))
- is_fill <- any(ifelse(xml_node_name(style[sty]) == "fill", TRUE, FALSE))
- is_border <- any(ifelse(xml_node_name(style[sty]) == "border", TRUE, FALSE))
- is_xf <- any(ifelse(xml_node_name(style[sty]) == "xf", TRUE, FALSE))
- is_celSty <- any(ifelse(xml_node_name(style[sty]) == "cellStyle", TRUE, FALSE))
- is_dxf <- any(ifelse(xml_node_name(style[sty]) == "dxf", TRUE, FALSE))
- is_tabSty <- any(ifelse(xml_node_name(style[sty]) == "tableStyle", TRUE, FALSE))
+ is_numfmt <- any(xml_node_name(style[sty]) == "numFmt")
+ is_font <- any(xml_node_name(style[sty]) == "font")
+ is_fill <- any(xml_node_name(style[sty]) == "fill")
+ is_border <- any(xml_node_name(style[sty]) == "border")
+ is_xf <- any(xml_node_name(style[sty]) == "xf")
+ is_celSty <- any(xml_node_name(style[sty]) == "cellStyle")
+ is_dxf <- any(xml_node_name(style[sty]) == "dxf")
+ is_tabSty <- any(xml_node_name(style[sty]) == "tableStyle")
 
  is_xf_fr <- isTRUE(attr(style, "cellStyleXf"))
 

R/class-workbook-utils.R

@@ -26,11 +26,11 @@ wb_validate_table_name <- function(wb, tableName) {
  # TODO add a strict = getOption("openxlsx2.tableName.strict", FALSE)
  # param to force these to allow to stopping
  if (nchar(tableName) > 255) {
- stop("tableName must be less than 255 characters.", call. = FALSE)
+ stop("table_name must be less than 255 characters.", call. = FALSE)
  }
 
  if (grepl("$", tableName, fixed = TRUE)) {
- stop("'$' character cannot exist in a tableName", call. = FALSE)
+ stop("'$' character cannot exist in a table_name", call. = FALSE)
  }
 
  if (grepl(" ", tableName, fixed = TRUE)) {
@@ -41,11 +41,11 @@ wb_validate_table_name <- function(wb, tableName) {
  # stop("tableName must begin with a letter or an underscore")
 
  if (grepl("R[0-9]+C[0-9]+", tableName, perl = TRUE, ignore.case = TRUE)) {
- stop("tableName cannot be the same as a cell reference, such as R1C1", call. = FALSE)
+ stop("table_name cannot be the same as a cell reference, such as R1C1", call. = FALSE)
  }
 
  if (grepl("^[A-Z]{1,3}[0-9]+$", tableName, ignore.case = TRUE)) {
- stop("tableName cannot be the same as a cell reference", call. = FALSE)
+ stop("table_name cannot be the same as a cell reference", call. = FALSE)
  }
 
  # only place where self is needed
@@ -162,7 +162,7 @@ wb_create_columns <- function(wb, sheet, cols) {
  col_df <- col_to_df(read_xml(wb$createCols(sheet, n = max(cols))))
 
  # found a few cols, but not all required cols. create the missing columns
- if (any(!cols %in% as.numeric(col_df$min))) {
+ if (!all(cols %in% as.numeric(col_df$min))) {
  beg <- max(as.numeric(col_df$min)) + 1
  end <- max(cols)
 

R/class-workbook.R

@@ -1561,7 +1561,7 @@ wbWorkbook <- R6::R6Class(
  sel <- which(pt$name == pivot_table)
  cid <- pt$cacheId[sel]
 
- uni_name <- paste0(stringi::stri_replace_all_fixed(slicer, ' ', '_'), cid)
+ uni_name <- paste0(stringi::stri_replace_all_fixed(slicer, " ", "_"), cid)
 
  ### slicer_cache
  sortOrder <- NULL
@@ -2517,16 +2517,16 @@ wbWorkbook <- R6::R6Class(
  )
  } else {
  write_file(
- head = '',
+ head = "",
  body = '<styleSheet xmlns:x="http://schemas.openxmlformats.org/spreadsheetml/2006/main"/>',
- tail = '',
+ tail = "",
  fl = file.path(xlDir, "styles.xml")
  )
  }
 
  if (length(self$calcChain)) {
  write_file(
- head = '',
+ head = "",
  body = pxml(self$calcChain),
  tail = "",
  fl = file.path(xlDir, "calcChain.xml")
@@ -2536,9 +2536,9 @@ wbWorkbook <- R6::R6Class(
  # write metadata file. required if cm attribut is set.
  if (length(self$metadata)) {
  write_file(
- head = '',
+ head = "",
  body = self$metadata,
- tail = '',
+ tail = "",
  fl = file.path(xlDir, "metadata.xml")
  )
  }
@@ -2592,7 +2592,7 @@ wbWorkbook <- R6::R6Class(
  WR$tmpDirPartName <- paste0(tmpDir, "/xl/", WR$Target)
  WR$fileExists <- file.exists(WR$tmpDirPartName)
 
- if (any(!WR$fileExists)) {
+ if (!all(WR$fileExists)) {
  missing_in_tmp <- WR$Target[!WR$fileExists]
  warning(
  "[WR] file expected to be in output is missing: ",
@@ -2634,7 +2634,7 @@ wbWorkbook <- R6::R6Class(
  WR$type <- basename(WR$Type)
  WR <- WR[WR$type != "hyperlink", ]
 
- if (any(!WR$fileExists)) {
+ if (!all(WR$fileExists)) {
  missing_in_tmp <- WR$Target[!WR$fileExists]
  warning(
  "[", folder, "] file expected to be in output is missing: ",
@@ -3377,7 +3377,8 @@ wbWorkbook <- R6::R6Class(
  stop("Invalid rows entered (<= 0).")
  }
 
- hidden <- all(collapsed == TRUE)
+ # all collapse = TRUE
+ hidden <- all(collapsed)
  collapsed <- rep(as.character(as.integer(collapsed)), length.out = length(cols))
 
  # Remove duplicates
@@ -3599,7 +3600,8 @@ wbWorkbook <- R6::R6Class(
  stop("Invalid rows entered (<= 0).")
  }
 
- hidden <- all(collapsed == TRUE)
+ # All collapsed = TRUE
+ hidden <- all(collapsed)
  collapsed <- rep(as.character(as.integer(collapsed)), length.out = length(rows))
 
  # Remove duplicates
@@ -4782,7 +4784,7 @@ wbWorkbook <- R6::R6Class(
  pos <- '<xdr:pos x="0" y="0" />'
 
  drawingsXML <- stri_join(
- '<xdr:absoluteAnchor>',
+ "<xdr:absoluteAnchor>",
  pos,
  sprintf('<xdr:ext cx="%s" cy="%s"/>', width, height),
  genBasePic(imageNo, next_id),
@@ -7847,9 +7849,9 @@ wbWorkbook <- R6::R6Class(
  ## write vml output
  if (self$vml[[i]] != "") {
  write_file(
- head = '',
+ head = "",
  body = pxml(self$vml[[i]]),
- tail = '',
+ tail = "",
  fl = file.path(dir, sprintf("vmlDrawing%s.vml", i))
  )
 
@@ -7951,9 +7953,9 @@ wbWorkbook <- R6::R6Class(
  ## Write drawing i (will always exist) skip those that are empty
  if (!all(self$drawings[[i]] == "")) {
  write_file(
- head = '',
+ head = "",
  body = pxml(self$drawings[[i]]),
- tail = '',
+ tail = "",
  fl = file.path(xldrawingsDir, stri_join("drawing", i, ".xml"))
  )
  if (!all(self$drawings_rels[[i]] == "")) {

R/class-worksheet.R

@@ -174,7 +174,7 @@ wbWorksheet <- R6::R6Class(
 
  if (!is.null(tab_color)) {
  tab_color <- xml_node_create("tabColor", xml_attributes = tab_color)
- tabColor <- sprintf('<sheetPr>%s</sheetPr>', tab_color)
+ tabColor <- sprintf("<sheetPr>%s</sheetPr>", tab_color)
  } else {
  tabColor <- character()
  }
@@ -280,7 +280,7 @@ wbWorksheet <- R6::R6Class(
  if (length(self$cols_attr)) {
  paste(c("<cols>", self$cols_attr, "</cols>"), collapse = "")
  },
- '</worksheet>',
+ "</worksheet>",
  sep = ""
  )
  },

R/converters.R

@@ -29,7 +29,7 @@ int2col <- function(x) {
 col2int <- function(x) {
  if (is.null(x)) return(NULL)
 
- if (is.numeric(x) || is.integer(x) || is.factor(x))
+ if (is.numeric(x) || is.factor(x))
  return(as.integer(x))
 
  if (!is.character(x)) {

R/helper-functions.R

@@ -66,7 +66,7 @@ create_hyperlink <- function(sheet, row = 1, col = 1, text = NULL, file = NULL)
  }
 
  if (is.null(text)) {
- str <- sprintf('=HYPERLINK(%s)', dest)
+ str <- sprintf("=HYPERLINK(%s)", dest)
  } else {
  str <- sprintf('=HYPERLINK(%s, \"%s\")', dest, text)
  }
@@ -114,7 +114,7 @@ validate_color <- function(color = NULL, or_null = FALSE, envir = parent.frame()
  ## create a total size of 8 in ARGB format
  color <- stringi::stri_pad_left(str = color, width = 8, pad = "F")
 
- if (any(!grepl("[A-F0-9]{8}$", color))) {
+ if (!all(grepl("[A-F0-9]{8}$", color))) {
  if (is.null(msg)) msg <- sprintf("`%s` ['%s'] is not a valid color", sx, color)
  stop(simpleError(msg))
  }

R/pivot_table.R

@@ -3,7 +3,7 @@ distinct <- function(x) {
  unis <- stringi::stri_unique(x)
  lwrs <- tolower(unis)
  dups <- duplicated(lwrs)
- unis[dups == FALSE]
+ unis[!dups]
 }
 
 # append number of duplicated value.
@@ -71,7 +71,7 @@ cacheFields <- function(wbdata, filter, rows, cols, data, slicer) {
  sharedItem <- NULL
  }
 
- if (any(is.na(dat))) {
+ if (anyNA(dat)) {
  containsBlank <- "1"
  containsSemiMixedTypes <- NULL
  } else {

R/pugixml.R

@@ -123,7 +123,7 @@ xml_node <- function(xml, level1 = NULL, level2 = NULL, level3 = NULL, ...) {
  if (length(lvl) == 1) z <- getXMLXPtr1(xml, level1)
  if (length(lvl) == 2) z <- getXMLXPtr2(xml, level1, level2)
  if (length(lvl) == 3) z <- getXMLXPtr3(xml, level1, level2, level3)
- if (length(lvl) == 3) if (level2 == "*") z <- unkgetXMLXPtr3(xml, level1, level3)
+ if (length(lvl) == 3 && level2 == "*") z <- unkgetXMLXPtr3(xml, level1, level3)
  }
 
  z

R/read.R

@@ -331,8 +331,8 @@ wb_to_df <- function(
  cc_tab <- unique(cc$c_t)
 
  # bool
- if (any(cc_tab == c("b"))) {
- sel <- cc$c_t %in% c("b")
+ if (any(cc_tab == "b")) {
+ sel <- cc$c_t %in% "b"
  cc$val[sel] <- as.logical(as.numeric(cc$v[sel]))
  cc$typ[sel] <- "b"
  }

R/utils.R

@@ -252,7 +252,7 @@ check_wb_dims_args <- function(args, select = NULL) {
 
  cond_acceptable_len_1 <- !is.null(args$from_row) || !is.null(args$from_col) || !is.null(args$x)
  nams <- names(args) %||% rep("", length(args))
- all_args_unnamed <- all(!nzchar(nams))
+ all_args_unnamed <- !any(nzchar(nams))
 
  if (length(args) == 1 && !cond_acceptable_len_1) {
  # Providing a single argument acceptable is only `x`
@@ -798,7 +798,7 @@ read_xml_files <- function(x) {
 #' @noRd
 un_list <- function(x) {
 
- names <- vapply(x, length, NA_integer_)
+ names <- lengths(x)
  nams <- NULL
  for (i in seq_along(names)) {
  nam <- rep(names(names[i]), names[i])

R/wb_functions.R

@@ -122,7 +122,7 @@ guess_col_type <- function(tt) {
 numfmt_is_date <- function(numFmt) {
 
  # if numFmt is character(0)
- if (length(numFmt) == 0) return(z <- NULL)
+ if (length(numFmt) == 0) return(NULL)
 
  numFmt_df <- read_numfmt(read_xml(numFmt))
  # we have to drop any square bracket part
@@ -152,7 +152,7 @@ numfmt_is_date <- function(numFmt) {
 numfmt_is_posix <- function(numFmt) {
 
  # if numFmt is character(0)
- if (length(numFmt) == 0) return(z <- NULL)
+ if (length(numFmt) == 0) return(NULL)
 
  numFmt_df <- read_numfmt(read_xml(numFmt))
  # we have to drop any square bracket part
@@ -184,7 +184,7 @@ numfmt_is_posix <- function(numFmt) {
 numfmt_is_hms <- function(numFmt) {
 
  # if numFmt is character(0)
- if (length(numFmt) == 0) return(z <- NULL)
+ if (length(numFmt) == 0) return(NULL)
 
  numFmt_df <- read_numfmt(read_xml(numFmt))
  # we have to drop any square bracket part
@@ -235,7 +235,7 @@ style_is_date <- function(cellXfs, numfmt_date) {
 style_is_posix <- function(cellXfs, numfmt_date) {
 
  # numfmt_date: some basic date formats and custom formats
- date_numfmts <- as.character(22)
+ date_numfmts <- "22"
  numfmt_date <- c(numfmt_date, date_numfmts)
 
  cellXfs_df <- read_xf(read_xml(cellXfs))