#' Set up a package for use with Rust extendr code
#'
#' Create the scaffolding needed to add Rust extendr code to an R package. `use_extendr()`
#' adds a small Rust library with a single Rust function that returns the string
#' `"Hello world!"`. It also adds wrapper code so this Rust function can be called from
#' R with `hello_world()`.
#'
#' @param path File path to the package for which to generate wrapper code.
#' @param crate_name String that is used as the name of the Rust crate.
#' If `NULL`, sanitized R package name is used instead.
#' @param lib_name String that is used as the name of the Rust library.
#' If `NULL`, sanitized R package name is used instead.
#' @param quiet Logical indicating whether any progress messages should be
#' generated or not.
#' @param overwrite Logical scalar or `NULL` indicating whether the files in the `path` should be overwritten.
#' If `NULL` (default), the function will ask the user whether each file should
#' be overwritten in an interactive session or do nothing in a non-interactive session.
#' If `FALSE` and each file already exists, the function will do nothing.
#' If `TRUE`, all files will be overwritten.
#' @param edition String indicating which Rust edition is used; Default `"2021"`.
#' @return A logical value (invisible) indicating whether any package files were
#' generated or not.
#' @export
use_extendr <- function(path = ".",
crate_name = NULL,
lib_name = NULL,
quiet = FALSE,
overwrite = NULL,
edition = c("2021", "2018")) {
# https://github.com/r-lib/cli/issues/434
local_quiet_cli(quiet)
if (!interactive()) {
overwrite <- overwrite %||% FALSE
}
rlang::check_installed("usethis")
# Root path computed from user input
root_path <- try_get_root_path(path)
# Root path computed from `{usethis}`
usethis_proj_path <- try_get_proj_path()
# If they do not match, something is off, try to set up temporary project
if (!isTRUE(root_path == usethis_proj_path)) {
usethis::local_project(path, quiet = quiet)
}
# Check project path once again
usethis_proj_path <- try_get_proj_path()
# Check what is current working directory
curr_path <- try_get_normalized_path(getwd)
# If they do not match, let's temporarily change working directory
if (!isTRUE(curr_path == usethis_proj_path)) {
withr::local_dir(usethis_proj_path)
}
# At this point, our working directory is at the project root and
# we have an active `{usethis}` project
rextendr_setup()
pkg_name <- pkg_name()
mod_name <- as_valid_rust_name(pkg_name)
if (is.null(crate_name)) {
crate_name <- mod_name
} else {
throw_if_invalid_rust_name(crate_name)
}
if (is.null(lib_name)) {
lib_name <- mod_name
} else {
throw_if_invalid_rust_name(lib_name)
}
src_dir <- rprojroot::find_package_root_file("src")
r_dir <- rprojroot::find_package_root_file("R")
if (!dir.exists(r_dir)) {
dir.create(r_dir)
cli::cli_alert_success("Creating {.file {pretty_rel_path(r_dir, path)}}.")
}
rust_src_dir <- file.path(src_dir, "rust", "src")
if (!dir.exists(rust_src_dir)) {
dir.create(rust_src_dir, recursive = TRUE)
cli::cli_alert_success("Creating {.file {pretty_rel_path(rust_src_dir, path)}}.")
}
use_rextendr_template(
"entrypoint.c",
save_as = file.path("src", "entrypoint.c"),
quiet = quiet,
overwrite = overwrite,
data = list(mod_name = mod_name)
)
use_rextendr_template(
"Makevars",
save_as = file.path("src", "Makevars"),
quiet = quiet,
overwrite = overwrite,
data = list(lib_name = lib_name)
)
use_rextendr_template(
"Makevars.win",
save_as = file.path("src", "Makevars.win"),
quiet = quiet,
overwrite = overwrite,
data = list(lib_name = lib_name)
)
use_rextendr_template(
"Makevars.ucrt",
save_as = file.path("src", "Makevars.ucrt"),
quiet = quiet,
overwrite = overwrite,
data = list(lib_name = lib_name)
)
use_rextendr_template(
"_gitignore",
save_as = file.path("src", ".gitignore"),
quiet = quiet,
overwrite = overwrite
)
usethis::use_build_ignore("src/.cargo")
edition <- match.arg(edition, several.ok = FALSE)
cargo_toml_content <- to_toml(
package = list(name = crate_name, publish = FALSE, version = "0.1.0", edition = edition),
lib = list(`crate-type` = array("staticlib", 1), name = lib_name),
dependencies = list(`extendr-api` = "*")
)
use_rextendr_template(
"Cargo.toml",
save_as = file.path("src", "rust", "Cargo.toml"),
quiet = quiet,
overwrite = overwrite,
data = list(cargo_toml_content = cargo_toml_content)
)
use_rextendr_template(
"lib.rs",
save_as = file.path("src", "rust", "src", "lib.rs"),
quiet = quiet,
overwrite = overwrite,
data = list(mod_name = mod_name)
)
use_rextendr_template(
"win.def",
save_as = file.path("src", paste0(pkg_name, "-win.def")),
quiet = quiet,
overwrite = overwrite,
data = list(mod_name = mod_name)
)
use_rextendr_template(
"extendr-wrappers.R",
save_as = file.path("R", "extendr-wrappers.R"),
quiet = quiet,
overwrite = FALSE,
data = list(pkg_name = pkg_name)
)
if (!isTRUE(quiet)) {
cli::cli_alert_success("Finished configuring {.pkg extendr} for package {.pkg {pkg_name}}.")
cli::cli_ul(
c(
"Please run {.fun rextendr::document} for changes to take effect."
)
)
}
return(invisible(TRUE))
}
try_get_normalized_path <- function(path_fn) {
tryCatch(normalizePath(path_fn(), winslash = "/", mustWork = FALSE), error = function(e) NA)
}
try_get_proj_path <- function() {
try_get_normalized_path(usethis::proj_get)
}
try_get_root_path <- function(path) {
try_get_normalized_path(function() rprojroot::find_package_root_file(path = path))
}
#' Checks if provided name is a valid Rust name (identifier)
#'
#' @param name \[ character(n) \] Names to test.
#' @return \[ logical(n) \] `TRUE` if the name is valid, otherwise `FALSE`.
#' @noRd
is_valid_rust_name <- function(name) {
# We require the name starts with a letter,
# ends with a letter or digit,
# and contains only alphanumeric ASCII chars, `-` or `_`.
stringi::stri_detect_regex(name, "^[A-z][\\A-z0-9_-]*[A-z0-9]$")
}
#' Convert R package name into equivalent valid Rust name.
#'
#' @param name \[ character(n) \] R names to convert.
#' @return \[ character(n) \] Equivalent Rust name (if exists), otherwise `NA`.
#' @noRd
as_valid_rust_name <- function(name) {
rust_name <- stringi::stri_replace_all_regex(name, "[^\\w-]", "_")
if (stringi::stri_detect_regex(rust_name, "^\\d")) {
rust_name <- paste0("_", rust_name)
}
throw_if_invalid_rust_name(rust_name)
rust_name
}
#' Verifies if a function argument is a valid Rust name.
#'
#' @param name \[ string \] Tested caller function argument.
#' @param call \[ env \] Environment of the caller, passed to `cli::cli_abort()`.
#' @noRd
throw_if_invalid_rust_name <- function(name, call = caller_env()) {
quo <- enquo(name) # nolint: object_usage_linter
if (!rlang::is_scalar_character(name) || !is_valid_rust_name(name)) {
cli::cli_abort(
c(
"Argument {.arg {as_name(quo)}} is invalid.",
"!" = "{.code {as_label(name)}} cannot be used as Rust package or library name."
),
call = call,
class = "rextendr_error"
)
}
}
#' Write templates from `inst/templates`
#'
#' `use_rextendr_template()` is a wrapper around `usethis::use_template()` when
#' it's available and otherwise implements a simple version of `use_template()`.
#'
#' @inheritParams usethis::use_template
#' @inheritParams use_extendr
#' @param overwrite Logical scalar or `NULL` indicating whether the file in the `path` should be overwritten.
#' If `FALSE` and the file already exists, the function will do nothing.
#' If `NULL` and the `usethis` package is installed, the function will ask the user whether the file should
#' be overwritten in an interactive session or do nothing in a non-interactive session.
#' Otherwise, the file will be overwritten.
#' @noRd
use_rextendr_template <- function(template,
save_as = template,
data = list(),
quiet = FALSE,
overwrite = NULL) {
local_quiet_cli(quiet)
if (isFALSE(overwrite) && file.exists(save_as)) {
cli::cli_alert("File {.path {save_as}} already exists. Skip writing the file.")
return(invisible(NULL))
}
if (is_installed("usethis") && is.null(overwrite)) {
created <- usethis::use_template(
template,
save_as = save_as,
data = data,
open = FALSE,
package = "rextendr"
)
return(invisible(created))
}
template_path <- system.file(
"templates",
template,
package = "rextendr",
mustWork = TRUE
)
template_content <- brio::read_file(template_path)
template_content <- glue::glue_data(
template_content,
.x = data,
.open = "{{{", .close = "}}}",
.trim = FALSE
)
write_file(
stringi::stri_trim(template_content),
path = save_as,
search_root_from = rprojroot::find_package_root_file(),
quiet = quiet,
overwrite = overwrite
)
invisible(TRUE)
}
# Wrap `rlang::is_installed()` for ease of mocking installed packages
is_installed <- function(pkg) {
rlang::is_installed(pkg)
}
pkg_name <- function(path = ".") {
x <- desc::desc(rprojroot::find_package_root_file("DESCRIPTION", path = path))
x$get("Package")
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.