Skip to content

Commit 4bd0eac

Browse files
cebarbozacebarboza
authored
Merge pull request #172 from mi-erasmusmc/161-CRAN-fix-insert-structure
Include insertStructure paths for CRAN fix
2 parents 41eb6b1 + 40d6d52 commit 4bd0eac

20 files changed

Lines changed: 211 additions & 278 deletions

‎DESCRIPTION‎

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -52,7 +52,6 @@ Imports:
5252
glue,
5353
stringr,
5454
zip,
55-
here,
5655
fs,
5756
usethis,
5857
dplyr,

‎NAMESPACE‎

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -46,7 +46,6 @@ importFrom(glue,
4646
glue,
4747
glue_collapse
4848
)
49-
importFrom(here,here)
5049
importFrom(jsonlite,toJSON)
5150
importFrom(renv,
5251
lockfile_read,

‎R/createResultsDir.R‎

Lines changed: 13 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -2,11 +2,10 @@
22
#'
33
#' @description
44
#' Creates a subdirectory for results based on the database name within a
5-
#' specified output directory. If the output directory is not provided, the
6-
#' current working directory is used.
5+
#' specified output directory.
76
#'
87
#' @param outputDir Character string. The path to the main output folder.
9-
#' If NULL, defaults to the current working directory. Default NULL.
8+
#' This must be supplied explicitly.
109
#' @param dbname Character string. The name of the database, used to suffix
1110
#' the results folder (e.g., "results_dbname").
1211
#'
@@ -34,26 +33,23 @@
3433
#' )
3534
#' unlink(outputDir, recursive = TRUE)
3635
createResultsDir <- function(
37-
outputDir = NULL,
36+
outputDir,
3837
dbname
3938
) {
39+
if (missing(outputDir)) {
40+
cli::cli_abort("{.arg outputDir} must be supplied explicitly.")
41+
}
4042
# Set folder location for results ----
4143
cli::cli_alert_info(
4244
"Creating locations to save results"
4345
)
44-
if (is.null(outputDir)) {
45-
outputDir <- getwd()
46-
checkmate::assertDirectoryExists(
47-
outputDir
48-
)
46+
checkmate::assertCharacter(outputDir, len = 1, any.missing = FALSE)
47+
if (!dir.exists(outputDir)) {
48+
dir.create(outputDir, recursive = TRUE)
49+
checkmate::assertDirectoryExists(outputDir)
4950
} else {
50-
if (!dir.exists(outputDir)) {
51-
dir.create(outputDir)
52-
checkmate::assertDirectoryExists(outputDir)
53-
} else {
54-
outputDir <- normalizePath(outputDir)
55-
checkmate::assertDirectoryExists(outputDir)
56-
}
51+
outputDir <- normalizePath(outputDir)
52+
checkmate::assertDirectoryExists(outputDir)
5753
}
5854
resultsDirName <- glue::glue(
5955
"results_{dbname}"
@@ -73,4 +69,4 @@ resultsDirName <- glue::glue(
7369
resultsDirName = resultsDirName
7470
)
7571
)
76-
}
72+
}

‎R/insertStructure.R‎

Lines changed: 74 additions & 70 deletions
Original file line numberDiff line numberDiff line change
@@ -4,11 +4,10 @@
44
#' It includes standard folders, R scripts, test and documentation files and it
55
#' installs a default list of DARWIN EU®/OHDSI packages.
66
#'
7-
#' It assumes an active R project has already been created and renv
8-
#' initialized.
9-
#'
10-
#' @param path Character string identifying the path to the study project,
11-
#' default `"."`.
7+
#' @param studyName Character string identifying the study, for example
8+
#' `"P1-C1-001"`. Hyphens are removed to create the package name.
9+
#' @param path Character string identifying an existing study folder in which
10+
#' the package will be created.
1211
#' @param n_obj Number of study objectives, default `n_obj = 3`.
1312
#'
1413
#' @return
@@ -17,21 +16,13 @@
1716
#' @examples
1817
#' \dontrun{
1918
#'
20-
#' # Creating package structure in current project
21-
#'
22-
#' # - Initialize renv
23-
#' renv::init()
24-
#'
25-
#' # - Install package development tools
26-
#' renv::install(c("usethis",
27-
#' "devtools",
28-
#' "studyGenerics"))
29-
#'
30-
#' # - Initialize DESCRIPTION
31-
#' usethis::use_description()
32-
#'
33-
#' # - Initialize package structure
34-
#' studyGenerics::insertStructure()
19+
#' # Create the package in an existing study folder
20+
#' study_path <- file.path(tempdir(), "P1-C1-001")
21+
#' dir.create(study_path)
22+
#' studyGenerics::insertStructure(
23+
#' studyName = "P1-C1-001",
24+
#' path = study_path
25+
#' )
3526
#'
3627
#' # - Initialize NAMESPACE
3728
#' devtools::document()
@@ -41,21 +32,33 @@
4132
#' }
4233
#'
4334
#' @export
44-
insertStructure <- function(
45-
path = ".",
46-
n_obj = 3
47-
) {
48-
49-
# Need an existing package to run the function
50-
if (!file.exists(file.path(path, "DESCRIPTION"))) {
51-
cli::cli_abort(
52-
message = c(
53-
"!" = "The path doesn't correspond to a package folder.",
54-
"x" = "A package must contain a DESCRIPTION file. No DESCRIPTION detected at {.path {path}}.",
55-
"i" = "Create a package first with {.fn usethis::create_package} or through the RStudio interface."
56-
)
57-
)
58-
}
35+
insertStructure <- function(
36+
studyName,
37+
path,
38+
n_obj = 3
39+
) {
40+
checkmate::assertCharacter(studyName, len = 1, any.missing = FALSE)
41+
checkmate::assertDirectoryExists(path)
42+
package_name <- gsub("-", "", studyName, fixed = TRUE)
43+
if (!grepl("^[A-Za-z][A-Za-z0-9.]*$", package_name)) {
44+
cli::cli_abort(
45+
message = c(
46+
"x" = "{.arg studyName} must produce a valid R package name.",
47+
"i" = "Use a study name beginning with a letter and containing only letters, numbers, periods, and hyphens."
48+
)
49+
)
50+
}
51+
if (file.exists(file.path(path, "DESCRIPTION"))) {
52+
cli::cli_abort("{.path {path}} already contains a package DESCRIPTION file.")
53+
}
54+
55+
usethis::create_package(
56+
path = path,
57+
fields = list(Package = package_name),
58+
check_name = FALSE,
59+
open = FALSE
60+
)
61+
renv::init(project = path, bare = TRUE, load = FALSE, restart = FALSE)
5962

6063
# Set up structure at specified project path
6164
cli::cli_h1("Setting up study package structure")
@@ -143,9 +146,11 @@ installPackageBundle <- function(path) {
143146
)
144147
}
145148

146-
for (pkg in pkg_names) {
147-
usethis::use_package(pkg)
148-
}
149+
withr::with_dir(path, {
150+
for (pkg in pkg_names) {
151+
usethis::use_package(pkg)
152+
}
153+
})
149154

150155
# Update lockfile
151156
renv::snapshot(
@@ -188,26 +193,28 @@ insertDocs <- function(path) {
188193
#'
189194
#' @return
190195
#' No return value.
191-
insertStudyFiles <- function(
192-
path = ".",
193-
n_obj = 3
194-
) {
195-
# R/
196-
if ("hello.R" %in% list.files(file.path(path, "R"))) {
197-
unlink(file.path(path, "R", "hello.R"))
198-
}
199-
usethis::use_r("createCohorts", open = FALSE)
200-
writeLines(createCohortsFun(), file.path(path, "R", "createCohorts.R"))
201-
usethis::use_r("runStudy", open = FALSE)
202-
writeLines(runStudyFun(n_obj), file.path(path, "R", "runStudy.R"))
203-
usethis::use_r("runDiagnostics", open = FALSE)
204-
writeLines(runDiagnosticsFun(), file.path(path, "R", "runDiagnostics.R"))
205-
usethis::use_r("utils", open = FALSE)
206-
usethis::use_r("globals", open = FALSE)
207-
usethis::use_r("merge", open = FALSE)
208-
for (i in 1:n_obj) {
209-
usethis::use_r(paste0("objective", i), open = FALSE)
210-
}
196+
insertStudyFiles <- function(
197+
path,
198+
n_obj = 3
199+
) {
200+
withr::with_dir(path, {
201+
# R/
202+
if ("hello.R" %in% list.files(file.path(path, "R"))) {
203+
unlink(file.path(path, "R", "hello.R"))
204+
}
205+
usethis::use_r("createCohorts", open = FALSE)
206+
writeLines(createCohortsFun(), file.path(path, "R", "createCohorts.R"))
207+
usethis::use_r("runStudy", open = FALSE)
208+
writeLines(runStudyFun(n_obj), file.path(path, "R", "runStudy.R"))
209+
usethis::use_r("runDiagnostics", open = FALSE)
210+
writeLines(runDiagnosticsFun(), file.path(path, "R", "runDiagnostics.R"))
211+
usethis::use_r("utils", open = FALSE)
212+
usethis::use_r("globals", open = FALSE)
213+
usethis::use_r("merge", open = FALSE)
214+
for (i in 1:n_obj) {
215+
usethis::use_r(paste0("objective", i), open = FALSE)
216+
}
217+
})
211218
# man/
212219
if (!dir.exists(file.path(path, "man"))) {
213220
dir.create(file.path(path, "man"))
@@ -235,11 +242,10 @@ insertStudyFiles <- function(
235242
#'
236243
#' @return
237244
#' No return value.
238-
insertTests <- function(
239-
path = "."
240-
) {
241-
242-
usethis::use_testthat()
245+
insertTests <- function(
246+
path
247+
) {
248+
withr::with_dir(path, usethis::use_testthat())
243249

244250
if (!dir.exists(file.path(path, "R")) | length(list.files(file.path(path, "R"))) == 0) {
245251
cli::cli_abort(
@@ -255,7 +261,7 @@ insertTests <- function(
255261
if (script == "globals.R") {
256262
next
257263
} else{ # remove ".R"
258-
usethis::use_test(substr(script, 1, nchar(script) -2), open = FALSE)
264+
withr::with_dir(path, usethis::use_test(substr(script, 1, nchar(script) -2), open = FALSE))
259265
}
260266
}
261267
}
@@ -368,8 +374,7 @@ runStudyFun <- function(n_obj = 3) {
368374
"#'",
369375
"#' @param cdm A cdm reference.",
370376
"#' @param dbname Character string giving the data source name.",
371-
"#' @param outputDir Character string giving the base output directory. If `NULL`,",
372-
"#' the current working directory is used.",
377+
"#' @param outputDir Character string giving the base output directory.",
373378
"#' @param test Logical indicating whether to run in test mode with a minimum",
374379
"#' cell count of `0` instead of `5`.",
375380
"#'",
@@ -384,7 +389,7 @@ runStudyFun <- function(n_obj = 3) {
384389
"runStudy <- function(",
385390
" cdm,",
386391
" dbname = 'TEST_DATA',",
387-
" outputDir = NULL,",
392+
" outputDir,",
388393
" test = FALSE",
389394
") {",
390395
"",
@@ -436,8 +441,7 @@ runDiagnosticsFun <- function(path = ".") {
436441
"#' @param cdm A cdm reference.",
437442
"#' @param dbname Data source name in character.",
438443
"#' @param outputDir Character string with the base output directory where study",
439-
"#' results, logs, and the final zip archive will be written. If `NULL`, the",
440-
"#' current working directory is used.",
444+
"#' results, logs, and the final zip archive will be written.",
441445
"#' @param test Logical indicating whether to run in test mode with a minimum",
442446
"#' cell count of `0` instead of `5`.",
443447
"#'",
@@ -457,7 +461,7 @@ runDiagnosticsFun <- function(path = ".") {
457461
"runDiagnostics <- function(",
458462
" cdm,",
459463
" dbname = 'TEST_DATA',",
460-
" outputDir = NULL,",
464+
" outputDir,",
461465
" test = FALSE",
462466
") {",
463467
"",

‎R/packageCellar.R‎

Lines changed: 15 additions & 27 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
#' `packageCellar()` saves files from a renv.lock file into the 'cellar' folder in `renv`
22
#'
3-
#' @param path Character string giving the cellar path. If omitted, defaults to `renv/cellar`.
3+
#' @param path Character string giving the cellar path. This must be supplied explicitly.
44
#' @param project Character string giving the project path. If omitted, defaults to `usethis::proj_get()`.
55
#' @param lockfile Character string giving the lockfile path. If omitted, defaults to `renv.lock` at the project base level provided by `usethis::proj_get()`.
66
#' @param type Character string specifying whether to download all packages (`"complete"`) or only packages from GitHub (`"github"`).
@@ -15,7 +15,7 @@
1515
#'
1616
#' \dontrun{
1717
#' # It will download the tar files for every package in the renv.lock
18-
#' packageCellar()
18+
#' packageCellar(path = file.path(tempdir(), "cellar"))
1919
#' }
2020
packageCellar <- function(
2121
path,
@@ -33,11 +33,7 @@ packageCellar <- function(
3333
)
3434
}
3535
if (missing(path)) {
36-
path <- file.path(
37-
project,
38-
"renv",
39-
"cellar"
40-
)
36+
cli::cli_abort("{.arg path} must be supplied explicitly.")
4137
}
4238
if (!dir.exists(path)) {
4339
dir.create(
@@ -161,9 +157,9 @@ downloadGithub <- function(
161157

162158
#' `installCellar()` install files already saved in a cellar
163159
#'
164-
#' @param path Character string giving the cellar path. If omitted, defaults to `renv/cellar`.
160+
#' @param path Character string giving the cellar path. This must be supplied explicitly.
165161
#' @param project Character string giving the project path. If omitted, defaults to `usethis::proj_get()`.
166-
#' @param library Character string giving the library path. If omitted, defaults to `renv/library`.
162+
#' @param library Character string giving the library path. This must be supplied explicitly.
167163
#' @param lockfile Character string giving the lockfile path. If omitted, defaults to `renv.lock` at the project base level provided by `usethis::proj_get()`.
168164
#'
169165
#' @returns Invisible
@@ -176,7 +172,10 @@ downloadGithub <- function(
176172
#'
177173
#' \dontrun{
178174
#' # It will install all packages in the cellar
179-
#' installCellar()
175+
#' installCellar(
176+
#' path = file.path(tempdir(), "cellar"),
177+
#' library = file.path(tempdir(), "library")
178+
#' )
180179
#' }
181180
installCellar <- function(
182181
path,
@@ -188,27 +187,16 @@ installCellar <- function(
188187
project <- usethis::proj_get()
189188
}
190189
if (missing(path)) {
191-
path <- file.path(
192-
project,
193-
"renv",
194-
"cellar"
195-
) |>
196-
normalizePath()
190+
cli::cli_abort("{.arg path} must be supplied explicitly.")
197191
}
198192
checkmate::assertDirectoryExists(path)
199193
if (missing(library)) {
200-
library <- file.path(
201-
project,
202-
"renv",
203-
"library"
204-
)
205-
library |>
206-
dir.create(
207-
recursive = TRUE
208-
)
209-
library <- library |>
210-
normalizePath()
194+
cli::cli_abort("{.arg library} must be supplied explicitly.")
195+
}
196+
if (!dir.exists(library)) {
197+
dir.create(library, recursive = TRUE)
211198
}
199+
library <- normalizePath(library)
212200
checkmate::assertDirectoryExists(library)
213201
if (missing(lockfile)) {
214202
lockfile <- file.path(

0 commit comments

Comments
 (0)