-
Notifications
You must be signed in to change notification settings - Fork 1
/
dev_package.R
177 lines (167 loc) · 5.98 KB
/
dev_package.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
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
#' Setups package to use the **distops** package
#'
#' @description This function setups the package to use the **distops** package.
#' It first creates the `DESCRIPTION` file adding the **Rcpp** and
#' **RcppParallel** packages to both the `Imports:` and `LinkingTo:` fields
#' and the **distops** package to the `LinkingTo:` field. It also adds the
#' `SystemRequirements: GNU make` field. It then creates the `NAMESPACE` file
#' adding the `importFrom()` directives for the **Rcpp** and **RcppParallel**
#' packages and the `useDynLib()` directive for packages with compiled code.
#' It finally creates the `src/Makevars` and `src/Makevars.win` files with the
#' appropriate compilation flags.
#'
#' @return Nothing.
#' @export
#'
#' @examples
#' \donttest{
#' use_distops()
#' }
use_distops <- function() {
if (length(list.files(path = "pathname", pattern = "\\.Rproj$")) == 0) return()
desc_path <- paste0(usethis::proj_path(), "/DESCRIPTION")
if (!fs::file_exists(desc_path)) return()
# Check if backup files are present
backup_files <- fs::dir_ls(
path = usethis::proj_path(),
type = "file",
glob = "*.bak",
recurse = TRUE
)
if (length(backup_files) > 0) {
usethis::ui_stop(
"Backup files are present in the project directory. Please remove them ",
"before running this function."
)
}
desc_class <- desc::desc(usethis::proj_get())
package_name <- desc_class$get_field("Package")
# Setup DESCRIPTION file
usethis::use_directory("src")
usethis::use_git_ignore(c("*.o", "*.so", "*.dll"), "src")
fs::file_delete(paste0(usethis::proj_path(), "/DESCRIPTION"))
fields <- lapply(desc_class$fields(), \(.x) desc_class$get_field(.x))
names(fields) <- desc_class$fields()
imports <- strsplit(fields$Imports, ", ")[[1]]
imports <- sort(unique(c(imports, "Rcpp", "RcppParallel")))
fields$Imports <- paste(imports, collapse = ", ")
linkingto <- strsplit(fields$LinkingTo, ", ")[[1]]
linkingto <- sort(unique(c(linkingto, "Rcpp", "RcppParallel", "distops")))
fields$LinkingTo <- paste(linkingto, collapse = ", ")
systemreqs <- strsplit(fields$SystemRequirements, ", ")[[1]]
systemreqs <- sort(unique(c(systemreqs, "GNU make")))
fields$SystemRequirements <- paste(systemreqs, collapse = ", ")
usethis::use_description(fields = fields)
# Setup NAMESPACE file
package_doc_file <- paste0(
usethis::proj_path(),
glue::glue("/R/{package_name}-package.R")
)
handle_existing_file(package_doc_file)
usethis::use_template(
template = "packagename-package.R",
save_as = glue::glue("R/{package_name}-package.R"),
data = list(Package = package_name),
open = FALSE,
package = "distops"
)
# Setup Makevars files
makevars_file <- paste0(usethis::proj_path(), "/src/Makevars")
handle_existing_file(makevars_file)
usethis::use_template(
template = "makevars",
save_as = glue::glue("src/Makevars"),
open = FALSE,
package = "distops"
)
makevars_win_file <- paste0(usethis::proj_path(), "/src/Makevars.win")
handle_existing_file(makevars_win_file)
usethis::use_template(
template = "makevars_win",
save_as = glue::glue("src/Makevars.win"),
open = FALSE,
package = "distops"
)
# Remove useless backup files
backup_files <- fs::dir_ls(
path = usethis::proj_path(),
type = "file",
glob = "*.bak",
recurse = TRUE
)
for (bf in backup_files) {
f <- fs::path_ext_remove(bf)
if (fs::file_exists(f) && tools::md5sum(f) == tools::md5sum(bf))
fs::file_delete(bf)
}
}
handle_existing_file <- function(file) {
if (!fs::file_exists(file)) return()
old_file <- paste0(file, ".bak")
if (fs::file_exists(old_file) && tools::md5sum(file) == tools::md5sum(old_file))
fs::file_delete(old_file)
else
usethis::ui_stop(c(
'The {usethis::ui_path(file)} file already existed and a backup file',
'{usethis::ui_path(old_file)} has also been create. Please review and',
'remove it and try again.'
))
fs::file_copy(file, old_file, overwrite = TRUE)
usethis::ui_info(c(
'The {usethis::ui_path(file)} file already existed. A backup was created',
'at {usethis::ui_path(old_file)}.'
))
fs::file_delete(file)
usethis::ui_todo(c(
'Make sure to merge the {usethis::ui_path(old_file)} file into the',
'{usethis::ui_path(file)} file.'
))
}
cap <- function(x) {
x <- tolower(x)
substr(x, 1, 1) <- toupper(substr(x, 1, 1))
x
}
#' Adds a distance function to the package
#'
#' @description This function adds a distance function to the package. It first
#' creates the `R/{distance_name}Distance.R` file with the R wrapper function
#' for the distance function. It then creates the
#' `src/{distance_name}Distance.cpp` file with the C++ implementation of the
#' distance function. It finally opens the latter file in the default editor.
#' The user will be able to implement the desired distance function in a way
#' compatible with the **RcppParallel** workflow.
#'
#' @param distance_name A character string specifying the name of the distance
#' that the user aims at implementing.
#'
#' @return Nothing.
#' @export
#'
#' @examples
#' \donttest{
#' use_distance("euclidean")
#' }
use_distance <- function(distance_name) {
if (length(list.files(path = "pathname", pattern = "\\.Rproj$")) == 0) return()
desc_path <- paste0(usethis::proj_path(), "/DESCRIPTION")
if (!fs::file_exists(desc_path)) return()
distance_name <- cap(distance_name)
usethis::use_template(
template = "dist.R",
save_as = glue::glue("R/{distance_name}Distance.R"),
data = list(DistanceName = distance_name),
open = FALSE,
package = "distops"
)
# Call usethis::use_template() to create and open a .cpp file in the src/
# directory where the user will be able to implement the desired distance
# function in a way compatible with RcppParallel.
usethis::use_template(
template = "dist.cpp",
save_as = glue::glue("src/{distance_name}Distance.cpp"),
data = list(DistanceName = distance_name),
open = TRUE,
package = "distops"
)
}