R/datasource-excel.R

Defines functions check_xlsx exists_dataset.datafire_xlsx_connection list_datasets.datafire_xlsx_connection remove_dataset.datafire_xlsx_connection write_dataset.datafire_xlsx_connection read_dataset.datafire_xlsx_connection con_print_body.datafire_xlsx_connection is_connected.datafire_xlsx_connection disconnect.datafire_xlsx_connection connect.datafire_xlsx_driver xlsx

Documented in xlsx

# Connection --------------------------------------------------------------

#' datafire Excel driver
#'
#' @export
xlsx <- function() {
  check_xlsx(check_dots = FALSE)
  new_driver(name = "XLSX", class = "datafire_xlsx_driver")
}


#' @export
connect.datafire_xlsx_driver <- function(x, path, ... ) {
  check_xlsx()
  new_connection(driver = x, path = path, class = "datafire_xlsx_connection")
}

#' @export
disconnect.datafire_xlsx_connection <- function(x, ...) {
  check_xlsx()
  x[["path"]] <- NULL
  invisible(x)
}

#' @export
is_connected.datafire_xlsx_connection <- function(x, ...) {
  !is.null(x[["path"]])
}

#' @export
con_print_body.datafire_xlsx_connection <- function(x, ...) {
  cat(paste0("  Path: ", x$path, "\n"))
  invisible(x)
}


# RW ----------------------------------------------------------------------

#' @export
read_dataset.datafire_xlsx_connection <- function(src, name, ...) {
  check_xlsx()
  data <- openxlsx::read.xlsx(src$path, sheet = name, ...)
  try_tibble(data)
}

#' @export
write_dataset.datafire_xlsx_connection <- function(dest, name, x, ...) {
  check_xlsx()
  openxlsx::write.xlsx(x, dest$path, sheetName = name, ...)
  invisible(x)
}

#' @export
remove_dataset.datafire_xlsx_connection <- function(loc, name, ...) {
  check_xlsx()
  wb <- openxlsx::loadWorkbook(loc$file)
  openxlsx::removeWorksheet(wb, sheet = name)
  openxlsx::saveWorkbook(wb, file = loc$file, overwrite = TRUE)
  invisible()
}

#' @export
list_datasets.datafire_xlsx_connection <- function(src, ...) {
  check_xlsx()
  if (file.exists(src$path)) {
    openxlsx::getSheetNames(src$path)
  } else {
    character()
  }
}

#' @export
exists_dataset.datafire_xlsx_connection <- function(src, name, ...) {
  check_xlsx()
  name %in% list_datasets(src)
}

check_xlsx <- function(check_dots = TRUE, env = parent.frame()) {
  if (check_dots) {
    ellipsis::check_dots_used(env)
  }
  stopifnot(requireNamespace("openxlsx", quietly = TRUE))
}
shunsambongi/datafire documentation built on Aug. 19, 2022, 9:57 a.m.