use standalone purrr (#408)

* use standalone purrr

* namespace is_true

* catching some lints of course

* address PR feedback

* remove commented glue interpolation

* revert to glue

DESCRIPTION

@@ -48,7 +48,6 @@ Imports:
     jsonlite,
     pkgbuild (>= 1.4.0),
     processx,
-    purrr,
     rlang (>= 1.0.5),
     rprojroot,
     stringi,
@@ -72,4 +71,3 @@ Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.3.2
 SystemRequirements: Rust 'cargo'; the crate 'libR-sys' must compile
     without error
-Config/rextendr/version: 0.3.1.9001

NAMESPACE

@@ -30,14 +30,6 @@ importFrom(dplyr,"%>%")
 importFrom(dplyr,mutate)
 importFrom(glue,glue)
 importFrom(glue,glue_collapse)
-importFrom(purrr,discard)
-importFrom(purrr,every)
-importFrom(purrr,flatten_chr)
-importFrom(purrr,map)
-importFrom(purrr,map2)
-importFrom(purrr,map2_chr)
-importFrom(purrr,map_if)
-importFrom(purrr,map_lgl)
 importFrom(rlang,"%||%")
 importFrom(rlang,.data)
 importFrom(rlang,.env)

NEWS.md

@@ -1,5 +1,6 @@
 # rextendr (development version)
 
+* `purrr` has been replaced with [`R/standalone-purrr.R`](https://github.com/r-lib/rlang/blob/main/R/standalone-purrr.R) removing `purrr` from `Imports` <https://github.com/extendr/rextendr/pull/408>
 * `document()` will no longer try to save all open files using rstudioapi <https://github.com/extendr/rextendr/issues/404> <https://github.com/extendr/rextendr/issues/407>
 * `use_cran_default()` has been removed as the default package template is CRAN compatible <https://github.com/extendr/rextendr/pull/394>
 * `use_extendr()` now creates `tools/msrv.R`, `configure` and `configure.win`. These have been moved out of `use_cran_defaults()` <https://github.com/extendr/rextendr/pull/393>

R/create_extendr_package.R

@@ -25,7 +25,7 @@ create_extendr_package <- function(path, ...) {
     if (rlang::is_string(x) && nzchar(x)) x else NULL
   }
 
-  args <- purrr::map(args, nullify_empty_string)
+  args <- map(args, nullify_empty_string)
 
   # build package directory, but don't start a new R session with
   # it as the working directory! i.e., set `open = FALSE`

R/eval.R

@@ -119,7 +119,7 @@ fn {fn_name}() -> Result<Robj> {{
 #'   `NULL` if no such dll is loaded.
 #' @noRd
 find_loaded_dll <- function(name) {
-  dlls <- purrr::keep(getLoadedDLLs(), ~ .x[["name"]] == name)
+  dlls <- keep(getLoadedDLLs(), ~ .x[["name"]] == name)
   if (rlang::is_empty(dlls)) {
     NULL
   } else {

R/find_exports.R

@@ -8,7 +8,7 @@ find_exports <- function(clean_lns) {
     return(tibble::tibble(name = character(0), type = character(0), lifetime = character(0)))
   }
 
-  purrr::map2(start, end, ~ extract_meta(clean_lns[.x:.y])) %>%
+  map2(start, end, ~ extract_meta(clean_lns[.x:.y])) %>%
     dplyr::bind_rows() %>%
     dplyr::mutate(type = dplyr::coalesce(.data$impl, .data$fn)) %>%
     dplyr::select(dplyr::all_of(c("name", "type", "lifetime")))

R/function_options.R

@@ -27,21 +27,21 @@ convert_function_options <- function(options, suppress_warnings) {
   options_table <- tibble::tibble(Name = rlang::names2(options), Value = unname(options)) %>%
     dplyr::left_join(extendr_function_config$known_options, by = "Name") %>%
     dplyr::mutate(
-      Value = purrr::pmap(
+      Value = pmap(
         list(.data$Value, .data$Ptype, .data$Name),
         ~ if (rlang::is_null(..2)) ..1 else vctrs::vec_cast(..1, ..2, x_arg = ..3)
       ),
     )
 
   unknown_option_names <- options_table %>%
-    dplyr::filter(purrr::map_lgl(.data$Ptype, rlang::is_null)) %>%
+    dplyr::filter(map_lgl(.data$Ptype, rlang::is_null)) %>%
     dplyr::pull(.data$Name)
 
   invalid_options <- options_table %>%
     dplyr::mutate(
       IsNameInvalid = !is_valid_rust_name(.data$Name),
-      IsValueNull = purrr::map_lgl(.data$Value, rlang::is_null),
-      IsNotScalar = !.data$IsValueNull & !purrr::map_lgl(.data$Value, vctrs::vec_is, size = 1L)
+      IsValueNull = map_lgl(.data$Value, rlang::is_null),
+      IsNotScalar = !.data$IsValueNull & !map_lgl(.data$Value, vctrs::vec_is, size = 1L)
     ) %>%
     dplyr::filter(
       .data$IsNameInvalid | .data$IsValueNull | .data$IsNotScalar
@@ -59,7 +59,7 @@ convert_function_options <- function(options, suppress_warnings) {
   options_table %>%
     dplyr::transmute(
       .data$Name,
-      RustValue = purrr::map_chr(.data$Value, convert_option_to_rust)
+      RustValue = map_chr(.data$Value, convert_option_to_rust)
     )
 }
 

R/generate_toml.R

@@ -3,6 +3,17 @@ generate_cargo.toml <- function(libname = "rextendr",
                                 patch.crates_io = NULL,
                                 extendr_deps = NULL,
                                 features = character(0)) {
+
+  # create an empty list if no dependencies are provided
+  deps <- dependencies %||% list()
+  # enabled extendr features that we need to impute into all of the
+  # dependencies
+  to_impute <- enable_features(extendr_deps, features)
+
+  for (.name in names(to_impute)) {
+    deps[[.name]] <- to_impute[[.name]]
+  }
+
   to_toml(
     package = list(
       name = libname,
@@ -13,10 +24,7 @@ generate_cargo.toml <- function(libname = "rextendr",
     lib = list(
       `crate-type` = array("cdylib", 1)
     ),
-    dependencies = purrr::list_modify(
-      dependencies %||% list(),
-      !!!enable_features(extendr_deps, features)
-    ),
+    dependencies = deps,
     `patch.crates-io` = patch.crates_io,
     `profile.perf` = list(
       inherits = "release",

R/rextendr.R

@@ -7,7 +7,6 @@
 "_PACKAGE"
 
 #' @importFrom dplyr   mutate %>%
-#' @importFrom purrr   map2 map2_chr map_lgl flatten_chr map_if every map discard
 #' @importFrom glue    glue glue_collapse
 #' @importFrom rlang   dots_list names2 as_function is_missing is_atomic is_null
 #' @importFrom rlang   is_na .data .env caller_env as_name as_label enquo %||%

R/sanitize_code.R

@@ -35,8 +35,8 @@ fill_block_comments <- function(lns, fill_with = " ") { # nolint: object_usage_l
   # A sorted DF having `start`, `end`, and `type`
   comment_syms <-
     locations %>%
-    purrr::map(tibble::as_tibble) %>%
-    purrr::imap(
+    map(tibble::as_tibble) %>%
+    imap(
       ~ dplyr::mutate(
         .x,
         type = dplyr::if_else(.y == 1L, "open", "close")
@@ -136,20 +136,16 @@ fill_block_comments <- function(lns, fill_with = " ") { # nolint: object_usage_l
   # of the same length -- this is needed to preserve line length
   # and previously computed positions, and it does not affect
   # parsing at later stages.
-  result <- purrr::reduce2(
-    to_replace[["start_open"]],
-    to_replace[["end_close"]],
-    function(ln, from, to) {
-      stringi::stri_sub(
-        ln,
-        from,
-        to,
-      ) <- strrep(fill_with, to - from + 1L)
-      ln
-    },
-    .init = lns
-  )
+  .open <- to_replace[["start_open"]]
+  .close <- to_replace[["end_close"]]
+  gap_size <- (.close - .open) + 1
 
+  result <- stringi::stri_sub_replace_all(
+    lns,
+    .open,
+    .close,
+    replacement = strrep(fill_with, gap_size)
+  )
 
   result <- stringi::stri_split_lines(result, omit_empty = TRUE)[[1]]
   result

R/source.R

@@ -404,10 +404,10 @@ invoke_cargo <- function(toolchain, specific_target, dir, profile,
 gather_cargo_output <- function(json_output, level, tty_has_colors) {
   rendered_output <-
     json_output %>%
-    purrr::keep(
+    keep(
       ~ .x$reason == "compiler-message" && .x$message$level == level
     ) %>%
-    purrr::map_chr(~ .x$message$rendered)
+    map_chr(~ .x$message$rendered)
 
   if (!tty_has_colors) {
     rendered_output <- cli::ansi_strip(rendered_output)
@@ -433,7 +433,7 @@ gather_cargo_output <- function(json_output, level, tty_has_colors) {
 #' @param call Caller environment used for error message formatting.
 #' @noRd
 check_cargo_output <- function(compilation_result, message_buffer, tty_has_colors, quiet, call = caller_env()) {
-  cargo_output <- purrr::map(
+  cargo_output <- map(
     message_buffer,
     jsonlite::parse_json
   )
@@ -445,7 +445,7 @@ check_cargo_output <- function(compilation_result, message_buffer, tty_has_color
         "error",
         tty_has_colors
       ) %>%
-      purrr::map_chr(
+      map_chr(
         cli::format_inline,
         keep_whitespace = TRUE
       ) %>%