Replaces arrow dependencies

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: mark
 Type: Package
 Title: Multipurpose Aids for R Kit
-Version: 0.8.3.9006
+Version: 0.8.3.9007
 Authors@R:
     person(given   = "Jordan Mark",
            family  = "Barbone",
@@ -33,14 +33,18 @@ Imports:
 Suggests:
     bench (>= 1.1.1),
     bib2df (>= 1.1.1),
-    crayon (>= 1.3.4),
+    clipr (>= 0.8.0),
     covr (>= 3.5.1),
+    crayon (>= 1.3.4),
     desc (>= 1.3.0),
     dplyr (>= 1.0.6),
     echo (>= 0.1.0),
+    feather,
     graphics (>= 3.6),
     haven,
+    jsonlite,
     knitr (>= 1.30),
+    nanoparquet,
     rcmdcheck (>= 1.3.3),
     stringi (>= 1.5.3),
     spelling (>= 2.2),
@@ -49,11 +53,7 @@ Suggests:
     waldo (>= 0.2.5),
     withr (>= 2.3.0),
     xopen,
-    yaml,
-    jsonlite,
-    arrow (>= 16.1.0),
-    readMDTable (>= 0.2.0),
-    clipr (>= 0.8.0)
+    yaml
 RoxygenNote: 7.3.3
 Roxygen: list(markdown = TRUE)
 Config/testthat/edition: 3
@@ -111,6 +111,7 @@ Collate:
     'percentile-rank.R'
     'plot.R'
     'pseudo-id.R'
+    'read.R'
     'recode.R'
     'reexports-fuj.R'
     'reexports-magrittr.R'

NEWS.md

@@ -12,6 +12,9 @@ cleanup (e.g., trimming whitespace and lowercasing) are not longer performed
 * `md5(bytes)` added to use `tools::md5sum(bytpes)` for **R > 4.2.0** [#258](https://github.com/jmbarbone/mark/issues/258)
 * `md5()` now uses little-endian serialization (_i.e._, `serialize(xdr = FALSE)`) for more consistent results across platforms and faster speed; which may cause hashes created prior to _change_
 * `{mark}`'s title has been updated
+* `write_file_md5(method = "feather")`, `write_file_md5(method = "parquet")` now use `{feather}` and `{nanoparquet}`, respectively, rather than `{arrow}` [#245](https://github.com/jmbarbone/mark/issues/245)
+* `read_clipboard("md")` no longer needs `{readMdTable}`
+* `read_clibpboard()` will always return a `tibble` if `{tibble}` is available (this can be turned off if `options(mark.tibble = FALSE)`)
 
 # mark 0.8.3
 

R/clipboard.R

@@ -2,42 +2,40 @@
 #'
 #' Wrappers for working with the clipboard
 #'
-#' @details As these functions rely on [clipr::read_clip()] and
-#' [utils::writeClipboard()] they are only available for Windows 10. For copying
-#' and pasting floats, there may be some rounding that can occur.
+#' @details For copying and pasting floats, there may be some rounding that can
+#'   occur.
 #'
-#' @param x An object
+#' @param x An object to write to the clipboard
 #' @param method Method switch for loading the clipboard
 #' @param ... Additional arguments sent to methods or to [utils::write.table()]
 #'
-#' @return `write_clipboard()` None, called for side effects `read_clipboard()`
-#' Either a vector, `data.frame`, or `tibble` depending on the `method` chosen.
-#' Unlike [utils::readClipboard()], an empty clipboard value returns `NA` rather
-#' than `""`
+#' @return [mark::write_clipboard()] None, called for side effects
+#'   [mark::read_clipboard()] Either a vector or `data.frame` (or `tibble`, if
+#'   depending on the `method` chosen. An empty clipboard value returns `NA`
+#'   (rather than `""`)
 #'
 #' @name clipboard
 #' @examples
 #' # Will only run on windows
-#' if (Sys.info()[["sysname"]] == "Windows") {
-#'   foo <- function(x) {
-#'     write_clipboard(x)
-#'     y <- read_clipboard()
-#'     res <- all.equal(x, y)
-#'     if (isTRUE(res)) return("All equal")
-#'     print(x)
-#'     print(y)
-#'   }
-#'   foo(1:4)
-#'   foo(seq(-1, 1, .02))
-#'   foo(Sys.Date() + 1:4)
-#'
-#'   # May have some rounding issues
-#'   x <- "0.316362437326461129"
+#' foo <- function(x) {
 #'   write_clipboard(x)
-#'   res <- as.character(read_clipboard())
-#'   all.equal(x, res)
-#'   x; res
+#'   y <- read_clipboard()
+#'   res <- all.equal(x, y)
+#'   if (isTRUE(res)) return("All equal")
+#'   print(x)
+#'   print(y)
 #' }
+#'
+#' foo(1:4)
+#' foo(seq(-1, 1, .02))
+#' foo(Sys.Date() + 1:4)
+#'
+#' # May have some rounding issues
+#' x <- "0.316362437326461129"
+#' write_clipboard(x)
+#' res <- as.character(read_clipboard())
+#' all.equal(x, res)
+#' x; res
 
 # nocov start
 
@@ -87,7 +85,7 @@ write_clipboard.list <- function(x, sep = "\t", ...) {
 #' @rdname clipboard
 read_clipboard <- function(method = read_clipboard_methods(), ...) {
   fuj::require_namespace("clipr")
-  switch(
+  res <- switch(
     match_param(method),
     default = type_convert2(clipr_read_clip(TRUE)),
     tibble = ,
@@ -100,29 +98,28 @@ read_clipboard <- function(method = read_clipboard_methods(), ...) {
     bsv = ,
     psv = read_clipboard("data.frame", sep = "|", ...),
     tsv = read_clipboard("data.frame", sep = "\t", ...),
-    md = {
-      fuj::require_namespace("readMDTable")
-      temp <- fs::file_temp()
-      on.exit(fs::file_delete(temp), add = TRUE)
-      writeLines(read_clipboard(), temp)
-      params <- list0(...)
-      params$file <- temp
-      params$show_col_types <- params$show_col_types %||% FALSE
-      params$col_types <- params$col_types %||% list(.default = "character")
-      type_convert2(do.call(readMDTable::read_md_table, params))
-    }
+    markdown = ,
+    md = type_convert2(mark_read_md(I(read_clipboard())))
   )
+
+  if (inherits(res, "data.frame")) {
+    tibble(res)
+  } else {
+    res
+  }
 }
 
 clipr_read_clip <- function(...) {
   res <- withCallingHandlers(
     clipr::read_clip(...),
     simpleWarning = function(e) {
-      if (grepl(
-        "System clipboard contained no readable text",
-        conditionMessage(e),
-        fixed = TRUE
-      )) {
+      if (
+        grepl(
+          "System clipboard contained no readable text",
+          conditionMessage(e),
+          fixed = TRUE
+        )
+      ) {
         tryInvokeRestart("muffleWarning")
       }
     }
@@ -149,6 +146,7 @@ read_clipboard_methods <- function() {
     "bsv",
     "psv",
     "tsv",
+    "markdown",
     "md",
     NULL
   )
@@ -163,47 +161,35 @@ read_clipboard_methods <- function() {
 #' @inheritParams utils::read.table
 #' @noRd
 do_read_table_clipboard <- function(
-    header           = TRUE,
-    # Copying form Excel produces tab separations
-    sep              = "\t",
-    # nolint next: object_name_linter.
-    row.names        = NULL,
-    # Excel formula for NA produces #N/A -- sometimes people use N/A...
-    # nolint next: object_name_linter.
-    na.strings       = c("", "NA", "N/A", "#N/A"),
-    # nolint next: object_name_linter.
-    check.names      = FALSE,
-    # nolint next: object_name_linter.
-    stringsAsFactors = FALSE,
-    encoding         = "UTF-8",
-    # occasionally "#' is used as a column name -- may cause issues
-    # nolint next: object_name_linter.
-    comment.char     = "",
-    # nolint next: object_name_linter.
-    blank.lines.skip = FALSE,
-    fill             = TRUE,
-    ...
+  header = TRUE,
+  # Copying form Excel produces tab separations
+  sep = "\t",
+  row.names = NULL, # nolint: object_name_linter.
+  # Excel formula for NA produces #N/A -- sometimes people use N/A...
+  na.strings = c("", "NA", "N/A", "#N/A"), # nolint: object_name_linter.
+  check.names = FALSE, # nolint: object_name_linter.
+  stringsAsFactors = FALSE, # nolint: object_name_linter.
+  encoding = "UTF-8",
+  # occasionally "#' is used as a column name -- may cause issues
+  comment.char = "", # nolint: object_name_linter.
+  blank.lines.skip = FALSE, # nolint: object_name_linter.
+  fill = TRUE,
+  ...
 ) {
-  res <- utils::read.table(
+  utils::read.table(
     file = textConnection(clipr_read_clip(TRUE)),
-    header           = header,
-    sep              = sep,
-    row.names        = row.names,
-    na.strings       = na.strings,
-    check.names      = check.names,
+    header = header,
+    sep = sep,
+    row.names = row.names,
+    na.strings = na.strings,
+    check.names = check.names,
     stringsAsFactors = stringsAsFactors,
-    encoding         = encoding,
-    comment.char     = comment.char,
+    encoding = encoding,
+    comment.char = comment.char,
     blank.lines.skip = blank.lines.skip,
-    fill             = fill,
+    fill = fill,
     ...
   )
-
-  if (package_available("tibble")) {
-    tibble::as_tibble(res)
-  } else {
-    res
-  }
 }
 
 clear_clipboard <- function() {
@@ -254,3 +240,11 @@ type_convert2 <- function(x) {
 
   res
 }
+
+tibble <- function(x) {
+  if (getOption("mark.tibble", TRUE) && package_available("tibble")) {
+    tibble::as_tibble(x)
+  } else {
+    x
+  }
+}

R/mark-package.R

@@ -33,7 +33,8 @@ op.mark <- list(
   mark.weeks_inn_year = 52,
   mark.default_tz = "UTC",
   mark.na_list = na_list,
-  mark.md5.bytes = NULL
+  mark.md5.bytes = NULL,
+  mark.tibble = TRUE
 )
 
 .onLoad <- function(libname, pkgname) {

R/read.R

@@ -0,0 +1,31 @@
+# from https://github.com/alistaire47/read.so/blob/master/R/md.R
+# NOTE read.so is not in CRAN
+
+mark_read_md <- function(
+  file,
+  sep = "|",
+  strip.white = TRUE, # nolint: object_name_linter.
+  ...
+) {
+  if (inherits(file, "AsIs")) {
+    file <- textConnection(as.character(file))
+    on.exit(if (isOpen(file)) close(file))
+  }
+
+  lines <- readLines(file)
+  lines <- grep(
+    "^[\\:\\s\\+\\-\\=\\_\\|]*$",
+    lines,
+    perl = TRUE,
+    invert = TRUE,
+    value = TRUE
+  )
+  lines <- gsub("(^\\s*?\\|)|(\\|\\s*?$)", "", lines)
+  lines <- paste(lines, collapse = "\n")
+  utils::read.delim(
+    text = lines,
+    sep = "|",
+    strip.white = strip.white,
+    ...
+  )
+}