Merge pull request #18 from ThinkR-open/test-refactor

fix: create_mariobox no longer use create_project

DESCRIPTION

@@ -27,4 +27,4 @@ Suggests:
 Config/testthat/edition: 3
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.2

R/create_pipework.R

@@ -1,5 +1,5 @@
 
-#' Create a {mariobox} project to package a {plumber} API
+#' Create a 'mariobox' project to package a 'plumber' API
 #'
 #' This function will create a prepopulated package
 #' with all the necessary elements to publish a {plumber} API as a package.
@@ -8,7 +8,7 @@
 #' the package in. The folder name will also be used as the package name.
 #' @param open A logical. Should the new project be open?
 #' @param overwrite A logical. Should the already existing project be overwritten ?
-#' @param package_name Package name to use. By default, {mariobox} uses
+#' @param package_name Package name to use. By default, 'mariobox' uses
 #' `basename(path)`. If `path == '.'` & `package_name` is not explicitly set,
 #' then `basename(getwd())` will be used.
 #'
@@ -36,11 +36,6 @@ create_mariobox <- function(
   overwrite = FALSE,
   package_name = basename(path)
 ) {
-  # if (check_name) {
-  #   cat_rule("Checking package name")
-  #   getFromNamespace("check_package_name", "usethis")(package_name)
-  #   cat_green_tick("Valid package name")
-  # }
 
   if (dir.exists(path)) {
     if (!isTRUE(overwrite)) {
@@ -58,43 +53,17 @@ create_mariobox <- function(
     }
   } else {
     cat_rule("Creating dir")
-    usethis::create_project(
-      path = path,
-      open = FALSE,
+    fs::dir_create(
+      path = path
     )
     cat_green_tick("Created package directory")
   }
 
   cat_rule("Copying package skeleton")
-  marioboxexample_path <- mariobox_sys("marioboxexample")
-  dir_copy(
-    path = marioboxexample_path,
-    new_path = path,
-    overwrite = TRUE
+  copy_empty_mariobox(
+    path,
+    package_name
   )
-  # Listing copied files ***from source directory***
-  copied_files <- list.files(
-    path = marioboxexample_path,
-    full.names = FALSE,
-    all.files = TRUE,
-    recursive = TRUE
-  )
-  # Going through copied files to replace package name
-  for (file in copied_files) {
-    copied_file <- file.path(path, file)
-    if (grepl("^REMOVEME", file)) {
-      file.rename(
-        from = copied_file,
-        to = file.path(path, gsub("REMOVEME", "", file))
-      )
-      copied_file <- file.path(path, gsub("REMOVEME", "", file))
-    }
-    replace_word(
-      file = copied_file,
-      pattern = "marioboxexample",
-      replace = package_name
-    )
-  }
   cat_green_tick("Copied app skeleton")
 
   cat_rule("Done")
@@ -123,3 +92,37 @@ create_mariobox <- function(
     )
   )
 }
+
+
+copy_empty_mariobox <- function(path, package_name){
+  marioboxexample_path <- mariobox_sys("marioboxexample")
+  dir_copy(
+    path = marioboxexample_path,
+    new_path = path,
+    overwrite = TRUE
+  )
+  # Listing copied files ***from source directory***
+  copied_files <- list.files(
+    path = marioboxexample_path,
+    full.names = FALSE,
+    all.files = TRUE,
+    recursive = TRUE
+  )
+  # Going through copied files to replace package name
+  for (file in copied_files) {
+    copied_file <- file.path(path, file)
+    if (grepl("^REMOVEME", file)) {
+      file.rename(
+        from = copied_file,
+        to = file.path(path, gsub("REMOVEME", "", file))
+      )
+      copied_file <- file.path(path, gsub("REMOVEME", "", file))
+    }
+    replace_word(
+      file = copied_file,
+      pattern = "marioboxexample",
+      replace = package_name
+    )
+  }
+  return(path)
+}

R/http_error.R

@@ -2,35 +2,35 @@
 #'
 #' @noRd
 http_error_codes <- structure(
-  list(category = c("Client Error", "Client Error", "Client Error", 
-  "Client Error", "Client Error", "Client Error", "Client Error", 
-  "Client Error", "Client Error", "Client Error", "Client Error", 
-  "Client Error", "Client Error", "Client Error", "Client Error", 
-  "Client Error", "Client Error", "Client Error", "Client Error", 
-  "Client Error", "Client Error", "Client Error", "Client Error", 
-  "Client Error", "Client Error", "Client Error", "Client Error", 
-  "Client Error", "Client Error", "Server Error", "Server Error", 
-  "Server Error", "Server Error", "Server Error", "Server Error", 
-  "Server Error", "Server Error", "Server Error", "Server Error", 
-  "Server Error"), status = c(400L, 401L, 402L, 403L, 404L, 405L, 
-  406L, 407L, 408L, 409L, 410L, 411L, 412L, 413L, 414L, 415L, 416L, 
-  417L, 418L, 421L, 422L, 423L, 424L, 425L, 426L, 428L, 429L, 431L, 
-  451L, 500L, 501L, 502L, 503L, 504L, 505L, 506L, 507L, 508L, 510L, 
-  511L), message = c("Bad Request", "Unauthorized", "Payment Required", 
-  "Forbidden", "Not Found", "Method Not Allowed", "Not Acceptable", 
-  "Proxy Authentication Required", "Request Timeout", "Conflict", 
-  "Gone", "Length Required", "Precondition Failed", "Payload Too Large", 
-  "URI Too Long", "Unsupported Media Type", "Range Not Satisfiable", 
-  "Expectation Failed", "I'm a teapot", "Misdirected Request", 
-  "Unprocessable Entity", "Locked", "Failed Dependency", "Too Early", 
-  "Upgrade Required", "Precondition Required", "Too Many Requests", 
-  "Request Header Fields Too Large", "Unavailable For Legal Reasons", 
-  "Internal Server Error", "Not Implemented", "Bad Gateway", "Service Unavailable", 
-  "Gateway Timeout", "HTTP Version Not Supported", "Variant Also Negotiates", 
+  list(category = c("Client Error", "Client Error", "Client Error",
+  "Client Error", "Client Error", "Client Error", "Client Error",
+  "Client Error", "Client Error", "Client Error", "Client Error",
+  "Client Error", "Client Error", "Client Error", "Client Error",
+  "Client Error", "Client Error", "Client Error", "Client Error",
+  "Client Error", "Client Error", "Client Error", "Client Error",
+  "Client Error", "Client Error", "Client Error", "Client Error",
+  "Client Error", "Client Error", "Server Error", "Server Error",
+  "Server Error", "Server Error", "Server Error", "Server Error",
+  "Server Error", "Server Error", "Server Error", "Server Error",
+  "Server Error"), status = c(400L, 401L, 402L, 403L, 404L, 405L,
+  406L, 407L, 408L, 409L, 410L, 411L, 412L, 413L, 414L, 415L, 416L,
+  417L, 418L, 421L, 422L, 423L, 424L, 425L, 426L, 428L, 429L, 431L,
+  451L, 500L, 501L, 502L, 503L, 504L, 505L, 506L, 507L, 508L, 510L,
+  511L), message = c("Bad Request", "Unauthorized", "Payment Required",
+  "Forbidden", "Not Found", "Method Not Allowed", "Not Acceptable",
+  "Proxy Authentication Required", "Request Timeout", "Conflict",
+  "Gone", "Length Required", "Precondition Failed", "Payload Too Large",
+  "URI Too Long", "Unsupported Media Type", "Range Not Satisfiable",
+  "Expectation Failed", "I'm a teapot", "Misdirected Request",
+  "Unprocessable Entity", "Locked", "Failed Dependency", "Too Early",
+  "Upgrade Required", "Precondition Required", "Too Many Requests",
+  "Request Header Fields Too Large", "Unavailable For Legal Reasons",
+  "Internal Server Error", "Not Implemented", "Bad Gateway", "Service Unavailable",
+  "Gateway Timeout", "HTTP Version Not Supported", "Variant Also Negotiates",
   "Insufficient Storage", "Loop Detected", "Not Extended", "Network Authentication Required"
-  )), row.names = c(400L, 401L, 402L, 403L, 404L, 405L, 406L, 407L, 
-  408L, 409L, 410L, 411L, 412L, 413L, 414L, 415L, 416L, 417L, 418L, 
-  421L, 422L, 423L, 424L, 425L, 426L, 428L, 429L, 431L, 451L, 500L, 
+  )), row.names = c(400L, 401L, 402L, 403L, 404L, 405L, 406L, 407L,
+  408L, 409L, 410L, 411L, 412L, 413L, 414L, 415L, 416L, 417L, 418L,
+  421L, 422L, 423L, 424L, 425L, 426L, 428L, 429L, 431L, 451L, 500L,
   501L, 502L, 503L, 504L, 505L, 506L, 507L, 508L, 510L, 511L), class = "data.frame")
 
 #' Produce HTTP errors
@@ -40,21 +40,21 @@ http_error_codes <- structure(
 #'
 #' @param status Integer, HTTP status code for the error (4xx or 5xx).
 #' @param message Character, the error message (can be a vector).
-#' 
+#'
 #' @return A condition object of class `"http_error"`.
 #'
 #' @export
 #'
 #' @examples
 #' ## R's default error
 #' str(attr(try(stop("Hey, stop!")), "condition"))
-#' 
+#'
 #' ## default status code 500 with default error message
 #' str(attr(try(http_error()), "condition"))
-#' 
+#'
 #' ## custom status code with default error message
 #' str(attr(try(http_error(501L)), "condition"))
-#' 
+#'
 #' ## custom status code for client error
 #' str(attr(try(http_error(400L, "Provide valid email address.")), "condition"))
 #'
@@ -71,16 +71,16 @@ http_error <- function(status = 500L, message = NULL) {
 
 #' Try an expression in a Plumber endpoint allowing error recovery
 #'
-#' This function is similar to [try()] and is called inside a Plumber API endpoint 
+#' This function is similar to [try()] and is called inside a Plumber API endpoint
 #' definition. The function needs access to Plumbers response object.
 #' Use [http_error()] to automate the handling of HTTP status codes
 #' and differentiate between server vs. client errors.
 #'
 #' @param res The HTTP response object.
 #' @param expr An R expression to try.
-#' @param message Logical, should the report of error messages be suppressed?
+#' @param silent Logical, should the report of error messages be suppressed?
 #' @param ... Other arguments passed to [try()].
-#' 
+#'
 #' @return The value of the expression if 'expr' is evaluated without error,
 #'      but an invisible object of class ‘"try-error"’ containing the
 #'      error message, and the error condition as the ‘"condition"’

tests/testthat/setup.R

@@ -0,0 +1,38 @@
+run_quietly_in_a_dummy_mariobox <- function(expr) {
+  on.exit(
+    {
+      dir_remove(
+        dummy_mariobox
+      )
+    },
+    add = TRUE
+  )
+  withr::with_options(
+    c("usethis.quiet" = TRUE),
+    {
+      dummy_mariobox <- create_dummy_mariobox()
+      withr::with_dir(
+        dummy_mariobox,
+        expr
+      )
+    }
+  )
+}
+
+dir_remove <- function(path) {
+  unlink(
+    x = path,
+    recursive = TRUE,
+    force = TRUE
+  )
+}
+
+create_dummy_mariobox <- function(){
+  copy_empty_mariobox(
+    file.path(
+      tempdir(),
+      "dummymariobox"
+    ),
+    "dummymariobox"
+  )
+}

tests/testthat/test-R.R

@@ -0,0 +1,5 @@
+test_that("",{
+ expect_true(
+  (1 + 1) == 2
+ )
+})

tests/testthat/test-build_plumber_file.R

@@ -0,0 +1,3 @@
+test_that("multiplication works", {
+  expect_equal(2 * 2, 4)
+})