forked from r-lib/usethis
-
Notifications
You must be signed in to change notification settings - Fork 0
/
r.R
62 lines (54 loc) · 1.68 KB
/
r.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
#' Create a new R file
#'
#' @param name File name, without extension; will create if it doesn't already
#' exist. If not specified, and you're currently in a test file, will guess
#' name based on test name.
#' @seealso [use_test()], and also the [R code
#' chapter](http://r-pkgs.had.co.nz/r.html) of [R
#' Packages](http://r-pkgs.had.co.nz).
#' @export
use_r <- function(name = NULL) {
name <- name %||% get_active_r_file(path = "tests/testthat")
name <- gsub("^test-", "", name)
name <- slug(name, "R")
check_file_name(name)
use_directory("R")
edit_file(proj_path("R", name))
invisible(TRUE)
}
check_file_name <- function(name) {
if (!valid_file_name(path_ext_remove(name))) {
stop_glue(
"{value(name)} is not a valid file name. It should:\n",
"* Contain only ASCII letters, numbers, '-', and '_'\n"
)
}
name
}
valid_file_name <- function(x) {
grepl("^[[:alnum:]_-]+$", x)
}
get_active_r_file <- function(path = "R") {
if (!rstudioapi::isAvailable()) {
stop_glue("Argument {code('name')} must be specified.")
}
## rstudioapi can return a path like '~/path/to/file' where '~' means
## R's notion of user's home directory
active_file <- path_expand_r(rstudioapi::getSourceEditorContext()$path)
rel_path <- proj_rel_path(active_file)
if (path_dir(rel_path) != path) {
stop_glue(
"Open file must be in the {value(path, '/')} directory of ",
"the active package.\n",
" * Actual path: {value(rel_path)}"
)
}
ext <- path_ext(active_file)
if (toupper(ext) != "R") {
stop_glue(
"Open file must have {value('.R')} or {value('.r')} as extension, ",
"not {value(ext)}."
)
}
path_file(active_file)
}