Merge pull request #202 from jmbarbone/167-globbing

167 globbing

NAMESPACE

@@ -153,6 +153,7 @@ export(get_recent_dir)
 export(get_recent_file)
 export(get_version)
 export(get_warning)
+export(glob)
 export(has_error)
 export(has_message)
 export(has_warning)

NEWS.md

@@ -1,5 +1,6 @@
 # mark (development version)
 
+* `glob()` added for basic wildcard globbing on character vectors [#167](https://github.com/jmbarbone/mark/issues/167)
 * adds greater use of `{fs}` over base file functions [#160](https://github.com/jmbarbone/mark/issues/160)
 * improvements in `todos()` and `fixmes()`
   * File extension can now be set [#170](https://github.com/jmbarbone/mark/issues/170), which by default includes `qmd` ([#163](https://github.com/jmbarbone/mark/issues/163)) and `py` files

R/glob.R

@@ -0,0 +1,30 @@
+#' Wildcard globbing
+#'
+#' Helper function for globbing character vectors
+#'
+#' @param x A vector of characters
+#' @param pattern Wildcard globbing pattern
+#' @param value,... Additional parameters passed to `grep`. Note: `value` is by
+#'   default `TRUE`; when `NA`, `...` is passed to `grepl`.
+#' @examples
+#' x <- c("apple", "banana", "peach", "pear", "orange")
+#' glob(x, "*e")
+#' glob(x, "pea*", value = FALSE)
+#' glob(x, "*an*", value = NA)
+#'
+#' path <- system.file("R", package = "mark")
+#' glob(list.files(path), "r*")
+#' @export
+glob <- function(x, pattern = NULL, value = TRUE, ...) {
+  pattern <- utils::glob2rx(pattern)
+  params <- list(...)
+  params$x <- x
+  params$pattern <- pattern
+
+  if (isNA(value)) {
+    do.call(grepl, params)
+  } else {
+    params$value <- value
+    do.call(grep, params)
+  }
+}

tests/testthat/test-glob.R

@@ -0,0 +1,14 @@
+test_that("glob() works", {
+  x <- c("apple", "banana", "peach", "pear", "orange")
+  obj <- glob(x, "*e")
+  exp <- c("apple", "orange")
+  expect_identical(obj, exp)
+
+  obj <- glob(x, "pea*", value = FALSE)
+  exp <- c(3L, 4L)
+  expect_identical(obj, exp)
+
+  obj <- glob(x, "*an*", value = NA)
+  exp <- c(FALSE, TRUE, FALSE, FALSE, TRUE)
+  expect_identical(obj, exp)
+})