Added project.directory parameter to create.project.R

R/create.project.R

@@ -10,6 +10,7 @@
 #'
 #' @param project.name A character vector containing the name for this new
 #'   project. Must be a valid directory name for your file system.
+#' @param project.directory A character vector containing the full path of the project directory up to and excluding the project.name.
 #' @param template A character vector containing the name of the template to
 #'   use for this project. By default a \code{full} and \code{minimal} template
 #'   are provided, but custom templates can be created using
@@ -41,24 +42,30 @@
 #' library('ProjectTemplate')
 #'
 #' \dontrun{create.project('MyProject')}
-create.project <- function(project.name = 'new-project', template = 'full',
-                           dump = FALSE, merge.strategy = c("require.empty", "allow.non.conflict"),
-                           rstudio.project = FALSE)
+create.project <- function(project.name = 'new-project',
+                           project.directory = getwd(),
+                           template = 'full',
+                           dump = FALSE,
+                           merge.strategy = c("require.empty", "allow.non.conflict"),
+                           rstudio.project = FALSE
+                           )
 {
 
+  project.path <- file.path(project.directory, project.name)
+
   .stopifproject(c("Cannot create a new project inside an existing one",
                            "Please change to another directory and re-run create.project()"),
-                 path = normalizePath(dirname(project.name)))
+                 path = normalizePath(dirname(project.path)))
 
   .stopifproject(c("Cannot create a new project inside an existing one",
                    "Please change to another directory and re-run create.project()"),
-                 path = dirname(normalizePath(dirname(project.name))))
+                 path = dirname(normalizePath(dirname(project.path))))
 
   merge.strategy <- match.arg(merge.strategy)
-  if (.is.dir(project.name)) {
-    .create.project.existing(project.name, merge.strategy, template, rstudio.project)
+  if (.is.dir(project.path)) {
+    .create.project.existing(project.name, project.directory, merge.strategy, template, rstudio.project)
   } else
-    .create.project.new(project.name, template, rstudio.project)
+    .create.project.new(project.name, project.directory, template, rstudio.project)
 
   if (dump)
   {
@@ -73,7 +80,7 @@ create.project <- function(project.name = 'new-project', template = 'full',
     for (item in pt.contents)
     {
       cat(deparse(get(item, envir = e, inherits = FALSE)),
-          file = file.path(project.name, paste(item, '.R', sep = '')))
+          file = file.path(project.path, paste(item, '.R', sep = '')))
     }
   }
 
@@ -87,6 +94,7 @@ create.project <- function(project.name = 'new-project', template = 'full',
 #' an existing directory with the default files from a given template.
 #'
 #' @param project.name Character vector with the name of the project directory
+#' @param project.directory Character vector with the full path of the project directory up to and excluding the project.name
 #' @param merge.strategy Character vector determining whether the directory
 #'   should be empty or is allowed to contain non-conflicting files
 #' @param template Name of the template from which the project should be created
@@ -99,11 +107,11 @@ create.project <- function(project.name = 'new-project', template = 'full',
 #' @keywords internal
 #'
 #' @rdname internal.create.project
-.create.project.existing <- function(project.name, merge.strategy, template, rstudio.project) {
+.create.project.existing <- function(project.name, project.directory, merge.strategy, template, rstudio.project) {
   template.path <- .get.template(template)
   template.files <- .list.files.and.dirs(path = template.path)
 
-  project.path <- file.path(project.name)
+  project.path <- file.path(project.directory, project.name)
 
   switch(
     merge.strategy,
@@ -128,11 +136,11 @@ create.project <- function(project.name = 'new-project', template = 'full',
   # Add project name to header
   README.md <- file.path(project.path, "README.md")
   README <- readLines(README.md)
-  writeLines(c(sprintf("# %s\n", basename(normalizePath(project.name))), README), README.md)
+  writeLines(c(sprintf("# %s\n", project.name), README), README.md)
 
   # Add RProj file to the project directory if the user has requested an RStudio project
   if(rstudio.project){
-    rstudiopath <- file.path(project.path, paste0(project.name,'.Rproj'))
+    rstudiopath <- paste0(project.path,'.Rproj')
     writeLines(.rstudioprojectfile(), rstudiopath)
   }
 }
@@ -149,19 +157,22 @@ create.project <- function(project.name = 'new-project', template = 'full',
 #' @keywords internal
 #'
 #' @rdname internal.create.project
-.create.project.new <- function(project.name, template, rstudio.project) {
-  if (file.exists(project.name)) {
-    stop(paste("Cannot run create.project() from a directory containing", project.name))
+.create.project.new <- function(project.name, project.directory, template, rstudio.project) {
+  project.path <- file.path(project.directory, project.name)
+
+  if (file.exists(project.path)) {
+    stop(paste("Cannot run create.project() at a directory containing", project.name))
   }
 
-  dir.create(project.name)
+  dir.create(project.path)
   tryCatch(
     .create.project.existing(project.name = project.name,
+                             project.directory = project.directory,
                              merge.strategy = "require.empty",
                              template = template,
                              rstudio.project = rstudio.project),
     error = function(e) {
-      unlink(project.name, recursive = TRUE)
+      unlink(project.path, recursive = TRUE)
       stop(e)
     }
   )

R/load.project.R

@@ -43,8 +43,6 @@ load.project <- function(...)
   assign('config', config, envir = .TargetEnv)
   my.project.info$config <- config
 
-  options(stringsAsFactors = config$as_factors)
-
   if (config$load_libraries) {
     my.project.info <- .load.libraries(config, my.project.info)
   }

tests/testthat/helper-functions_and_data.R

@@ -4,14 +4,14 @@
 #'
 #' @keywords tests
 tidy_up <- function() {
-  objs <- ls(envir = .TargetEnv)
-  rm(list = objs, envir = .TargetEnv)
+    objs <- ls(envir = .TargetEnv)
+    rm(list = objs, envir = .TargetEnv)
 }
 
 # Character vector holding the available cache file formats for testing
 cache_file_formats <- "RData"
 if (requireNamespace("qs", quietly = TRUE)) {
-  cache_file_formats <- c(cache_file_formats, "qs")
+    cache_file_formats <- c(cache_file_formats, "qs")
 }
 
 #' Set cache file format for testing
@@ -22,11 +22,11 @@ if (requireNamespace("qs", quietly = TRUE)) {
 #'
 #' @keywords tests
 set_cache_file_format <- function(cache_file_format) {
-  if (cache_file_format != "RData") {
-    config <- .read.config()
-    config$cache_file_format <- cache_file_format
-    .save.config(config)
-  }
+    if (cache_file_format != "RData") {
+        config <- .read.config()
+        config$cache_file_format <- cache_file_format
+        .save.config(config)
+    }
 
   invisible(cache_file_format)
 }

tests/testthat/test-add_config.R

@@ -1,46 +1,49 @@
-context('Add custom configuration')
+test_that("Custom configuration is added to config", {
+    test_project <- tempfile("test_project")
 
-test_that('Custom configuration is added to config', {
-  test_project <- tempfile('test_project')
-  suppressMessages(create.project(test_project))
-  on.exit(unlink(test_project, recursive = TRUE), add = TRUE)
+    suppressMessages(create.project(basename(test_project),
+        project.directory = dirname(test_project)
+    ))
+    on.exit(unlink(test_project, recursive = TRUE), add = TRUE)
 
-  oldwd <- setwd(test_project)
-  on.exit(setwd(oldwd), add = TRUE)
-  on.exit(clear(), add = TRUE)
+    oldwd <- setwd(test_project)
+    on.exit(setwd(oldwd), add = TRUE)
+    on.exit(clear(), add = TRUE)
 
-  expect_warning(load.project(), NA)
-  expect_error(add.config(new_config = 'a'), NA)
-  expect_equal(config$new_config, 'a')
+    expect_warning(load.project(), NA)
+    expect_error(add.config(new_config = "a"), NA)
+    expect_equal(config$new_config, "a")
 })
 
-test_that('Unnamed added configuration raises an error', {
-  test_project <- tempfile('test_project')
-  suppressMessages(create.project(test_project))
-  on.exit(unlink(test_project, recursive = TRUE), add = TRUE)
+test_that("Unnamed added configuration raises an error", {
+    test_project <- tempfile("test_project")
+    suppressMessages(create.project(basename(test_project),
+        project.directory = dirname(test_project)
+    ))
+    on.exit(unlink(test_project, recursive = TRUE), add = TRUE)
 
-  oldwd <- setwd(test_project)
-  on.exit(setwd(oldwd), add = TRUE)
-  on.exit(clear(), add = TRUE)
+    oldwd <- setwd(test_project)
+    on.exit(setwd(oldwd), add = TRUE)
+    on.exit(clear(), add = TRUE)
 
-  expect_warning(load.project(), NA)
-  expect_error(add.config('a'), 'All options should be named')
+    expect_warning(load.project(), NA)
+    expect_error(add.config("a"), "All options should be named")
 })
 
-test_that('Added configuration is displayed correctly by project.config()', {
-  test_project <- tempfile('test_project')
-  suppressMessages(create.project(test_project))
-  on.exit(unlink(test_project, recursive = TRUE), add = TRUE)
+test_that("Added configuration is displayed correctly by project.config()", {
+    test_project <- tempfile("test_project")
+    suppressMessages(create.project(basename(test_project),
+        project.directory = dirname(test_project)
+    ))
+    on.exit(unlink(test_project, recursive = TRUE), add = TRUE)
 
-  oldwd <- setwd(test_project)
-  on.exit(setwd(oldwd), add = TRUE)
-  on.exit(clear(), add = TRUE)
+    oldwd <- setwd(test_project)
+    on.exit(setwd(oldwd), add = TRUE)
+    on.exit(clear(), add = TRUE)
 
-  expect_warning(load.project(), NA)
-  expect_error(add.config(dummy = 999), NA)
+    expect_warning(load.project(), NA)
+    expect_error(add.config(dummy = 999), NA)
 
-  expect_message(project.config(), "Additional custom config present")
-  expect_message(project.config(), "dummy[ ]+999")
+    expect_message(project.config(), "Additional custom config present")
+    expect_message(project.config(), "dummy[ ]+999")
 })
-
-

tests/testthat/test-add_extension.R

@@ -1,32 +1,36 @@
-context('AddExtension')
-
-test_that('Test 1: Add an extension', {
-  foo1.reader <- function() {}
-
-  .add.extension('foo1', 'foo1.reader')
-  on.exit(rm(foo1.reader), add = TRUE)
-  expect_that(extensions.dispatch.table[['\\.foo1$']], equals('foo1.reader'))
-
-  test_project <- tempfile('test_project')
-  suppressMessages(create.project(test_project))
-  on.exit(unlink(test_project, recursive = TRUE), add = TRUE)
-
-  oldwd <- setwd(test_project)
-  on.exit(setwd(oldwd), add = TRUE)
-
-  file.copy(file.path(system.file('example_data',
-                                    package = 'ProjectTemplate'),
-                        'foo.reader.R'), file.path('lib', 'foo.reader.R'))
-  file.copy(file.path(system.file('example_data',
-                                    package = 'ProjectTemplate'),
-                        'example.foo'), file.path('data', 'example.foo'))
-
-  expect_true(file.exists(file.path('lib', 'foo.reader.R')))
-  expect_true(file.exists(file.path('data', 'example.foo')))
-
-  load.project()
-  expect_that(extensions.dispatch.table[['\\.foo$']], equals('foo.reader'))
-  expect_that(get('example',envir = .GlobalEnv), equals("bar"))
-
-
+test_that("Test 1: Add an extension", {
+    foo1.reader <- function() {}
+
+    .add.extension("foo1", "foo1.reader")
+    on.exit(rm(foo1.reader), add = TRUE)
+    expect_equal(extensions.dispatch.table[["\\.foo1$"]], "foo1.reader")
+
+    test_project <- tempfile("test_project")
+    suppressMessages(create.project(basename(test_project),
+        project.directory = dirname(test_project)
+    ))
+    on.exit(unlink(test_project, recursive = TRUE), add = TRUE)
+
+    oldwd <- setwd(test_project)
+    on.exit(setwd(oldwd), add = TRUE)
+
+    file.copy(file.path(
+        system.file("example_data",
+            package = "ProjectTemplate"
+        ),
+        "foo.reader.R"
+    ), file.path("lib", "foo.reader.R"))
+    file.copy(file.path(
+        system.file("example_data",
+            package = "ProjectTemplate"
+        ),
+        "example.foo"
+    ), file.path("data", "example.foo"))
+
+    expect_true(file.exists(file.path("lib", "foo.reader.R")))
+    expect_true(file.exists(file.path("data", "example.foo")))
+
+    load.project()
+    expect_equal(extensions.dispatch.table[["\\.foo$"]], "foo.reader")
+    expect_equal(get("example", envir = .GlobalEnv), "bar")
 })

tests/testthat/test-autogen.R

@@ -1,18 +1,16 @@
-context('Testing Autogeneration')
+test_that("stub.tests", {
+    test_project <- tempfile("test_project")
+    suppressMessages(create.project(basename(test_project),
+        project.directory = dirname(test_project)
+    ))
+    on.exit(unlink(test_project, recursive = TRUE), add = TRUE)
 
-test_that('stub.tests', {
+    oldwd <- setwd(test_project)
+    on.exit(setwd(oldwd), add = TRUE)
 
-  test_project <- tempfile('test_project')
-  suppressMessages(create.project(test_project))
-  on.exit(unlink(test_project, recursive = TRUE), add = TRUE)
-
-  oldwd <- setwd(test_project)
-  on.exit(setwd(oldwd), add = TRUE)
-
-  suppressMessages(stub.tests())
-
-  expect_true(file.exists(file.path('tests', 'autogenerated.R')))
-  test.code <- scan(file.path('tests', 'autogenerated.R'), what = 'character', sep = '\n', quiet = TRUE)
-  expect_that(test.code, equals("expect_that(helper.function(), equals(NULL))"))
+    suppressMessages(stub.tests())
 
+    expect_true(file.exists(file.path("tests", "autogenerated.R")))
+    test.code <- scan(file.path("tests", "autogenerated.R"), what = "character", sep = "\n", quiet = TRUE)
+    expect_equal(test.code, "expect_that(helper.function(), equals(NULL))")
 })