Update engine.R

Add validation tests - check path length - add more config validation tests Update engine.R nope windows!! WIP - `%||%` fallback - Use examplesIf - Remove pipes for better compatibility (should check what version of R current plumber is compatible with) - Remove default values for install/uninstall (should do something with the enum) - Set minimum plumber version (probably too early a version, should check) WIP Minor docs and action changes is it autostart? How about this? Revert - Perhaps it's the httpuv client not closing fast enough when it finds a new port? Update engine.R Update engine.R that really shouldn't have worked cleanup Update engine.R Update engine.R
ElianHugh · Sep 16, 2024 · cdcf0ea · cdcf0ea
1 parent d944afb
commit cdcf0ea
Show file tree

Hide file tree

Showing 24 changed files with 204 additions and 97 deletions.
diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml
@@ -22,9 +22,7 @@ jobs:
         config:
           - {os: macos-latest,   r: 'release'}
           - {os: windows-latest, r: 'release'}
-          - {os: ubuntu-latest,   r: 'devel', http-user-agent: 'release'}
-          - {os: ubuntu-latest,   r: 'release'}
-          - {os: ubuntu-latest,   r: 'oldrel-1'}
+          - {os: ubuntu-latest,  r: 'release'}
 
     env:
       GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}

diff --git a/.lintr b/.lintr
@@ -3,7 +3,49 @@ linters: linters_with_defaults(
   implicit_integer_linter(),
   indentation_linter(indent = 4L),
   object_name_linter(styles = c("snake_case", "symbols"), regexes = character()),
-  object_usage_linter = NULL
+  unused_import_linter(
+  allow_ns_usage = FALSE,
+  except_packages = c("bit64", "data.table", "tidyverse"),
+  interpret_glue = TRUE
+  ),
+  object_usage_linter = NULL,
+  sprintf_linter(),
+  outer_negation_linter(),
+  missing_argument_linter(),
+  missing_package_linter(),
+  duplicate_argument_linter(),
+  length_test_linter(),
+  redundant_equals_linter(),
+  equals_na_linter(),
+  unreachable_code_linter(),
+  boolean_arithmetic_linter(),
+  # package linters
+  package_hooks_linter(),
+  backport_linter(r_version = getRversion(), except = character()),
+  yoda_test_linter(),
+  expect_true_false_linter(),
+  expect_comparison_linter(),
+  expect_identical_linter(),
+  expect_type_linter(),
+  ifelse_censor_linter(),
+  scalar_in_linter(),
+  keyword_quote_linter(),
+  nonportable_path_linter(lax = TRUE),
+  paren_body_linter(),
+  paste_linter(
+  allow_empty_sep = FALSE,
+  allow_to_string = FALSE,
+  allow_file_path = c("double_slash", "always", "never")
+  ),
+  class_equals_linter(),
+  condition_message_linter(),
+  nested_ifelse_linter(),
+  string_boundary_linter(allow_grepl = FALSE),
+  inner_combine_linter(),
+  seq_linter(),
+  sort_linter(),
+  regex_subset_linter(),
+  library_call_linter(allow_preamble = TRUE)
   )
 exclusions: list("man/", "inst/", "src/", ".vscode/", ".Rproj.user/", "R/import-standalone-obj-type.R", "R/import-standalone-types-check.R")
 encoding: "UTF-8"
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -14,7 +14,7 @@ Imports:
     httr2,
     nanonext,
     mirai,
-    plumber,
+    plumber (>= 0.4.0),
     utils
 Suggests:
     box,

diff --git a/R/config.R b/R/config.R
@@ -12,7 +12,7 @@ new_config <- function(...) {
         new_port(host = host)
     ignore <- dots$ignore %||%
         utils::glob2rx(
-            paste0(
+            paste(
                 c("*.sqlite", "*.git*"),
                 collapse = "|"
             )
@@ -39,11 +39,15 @@ new_config <- function(...) {
 validate_config <- function(config) {
     stopifnot(is_config(config))
 
+    if (length(config$entry_path) > 1L) {
+        error_invalid_path_length(config$entry_path)
+    }
+
     if (!file.exists(config$entry_path) || dir.exists(config$entry_path)) {
         error_invalid_path(config$entry_path)
     }
 
-    if (!is.null(config$dirs) && any(!dir.exists(config$dirs))) {
+    if (!is.null(config$dirs) && !all(dir.exists(config$dirs))) {
         invalid <- config$dirs[!dir.exists(config$dirs)]
         error_invalid_dir(invalid)
     }
@@ -74,5 +78,5 @@ new_port <- function(used, host = "127.0.0.1") {
 }
 
 is_config <- function(x) {
-    "hotwater_config" %in% class(x)
+    inherits(x, "hotwater_config")
 }
diff --git a/R/engine.R b/R/engine.R
@@ -1,3 +1,7 @@
+# this file contains the construction, destruction, and running of the engine.
+# "engine" refers to the superclass that contains the configuration, runner,
+# and publisher for the given hotwater. also, it's amusing to call it a "hotwater engine".
+
 new_engine <- function(config) {
     stopifnot(is_config(config))
     structure(
@@ -26,9 +30,7 @@ run_engine <- function(engine) {
         teardown_engine(engine)
         buildup_engine(engine)
     }
-    on.exit({
-        teardown_engine(engine)
-    })
+    on.exit({ teardown_engine(engine) }) # nolint: brace_linter.
 
     cli_welcome()
     buildup_engine(engine)
@@ -42,7 +44,7 @@ run_engine <- function(engine) {
     )
 
     repeat {
-        Sys.sleep(0.05)
+        Sys.sleep(0.05) # todo, allow this to be configured at some point
         current_state <- watch_directory(
             engine,
             current_state,
@@ -61,12 +63,14 @@ buildup_engine <- function(engine) {
 
     cli_server_start_progress(engine)
     res <- new_runner(engine)
+
     if (!res) {
         cli::cli_progress_done(result = "failed")
     } else {
         publish_browser_reload(engine)
         cli::cli_progress_done()
     }
+
     cli_watching_directory(engine)
 }
 
@@ -75,6 +79,7 @@ teardown_engine <- function(engine) {
 
     cli_server_stop_progress()
     resp <- kill_engine(engine)
+
     if (isTRUE(resp)) {
         cli::cli_process_done()
     } else {
@@ -83,5 +88,5 @@ teardown_engine <- function(engine) {
 }
 
 is_engine <- function(x) {
-    "hotwater_engine" %in% class(x)
+    inherits(x, "hotwater_engine")
 }
diff --git a/R/errors.R b/R/errors.R
@@ -8,11 +8,24 @@ new_hotwater_warning <- function(type) {
 
 error_invalid_path <- function(path) {
     cli::cli_abort(
-        "Invalid path: {.file {path}}",
+        c(
+            "Invalid path: {.file {path}}",
+            x = "{.file {path}} not a valid path to a file"
+        ),
         class = new_hotwater_error("invalid_path")
     )
 }
 
+error_invalid_path_length <- function(path) {
+    cli::cli_abort(
+        c(
+            "Invalid path: {.file {path}}",
+            x = "{.file {path}} must be length 1L"
+        ),
+        class = new_hotwater_error("invalid_path_length")
+    )
+}
+
 error_invalid_dir <- function(dir) {
     cli::cli_abort(
         "Invalid directory: {.file {dir}}",

diff --git a/R/middleware.R b/R/middleware.R
@@ -1,27 +1,39 @@
+# middleware for the engine, ensures that we can tell if the API is up and running,
+# and that we can embed some javascript to autoreload local web pages using the API.
+
 injection <- function(engine) {
-    system.file("middleware", "injection.html", package = "hotwater", mustWork = TRUE) |>
-        readLines() |>
-        paste0(collapse = "\n") |>
-        sprintf(engine$publisher$listener[[1L]]$url)
+    injection_lines <- readLines(
+        system.file("middleware", "injection.html", package = "hotwater", mustWork = TRUE)
+    )
+
+    sprintf(
+        paste(injection_lines, collapse = "\n"),
+        engine$publisher$listener[[1L]]$url
+    )
 }
 
 middleware <- function(engine) {
     js <- injection(engine)
     hook <- postserialise_hotwater(js)
     function(pr) {
-        pr |>
-            # remove hotwater from the api spec
-            plumber::pr_set_api_spec(function(spec) {
-                spec$paths[["/__hotwater__"]] <- NULL
-                spec
-            }) |>
-            # the dummy path is needed for pinging the server from hotwater
-            plumber::pr_get(
-                "/__hotwater__", function() "running",
-                serializer = plumber::serializer_text(),
-                preempt = "__first__"
-            ) |>
-            plumber::pr_hook("postserialize", hook)
+        # remove hotwater from the api spec
+        plumber::pr_set_api_spec(pr, function(spec) {
+            spec$paths[["/__hotwater__"]] <- NULL
+            spec
+        })
+        # the dummy path is needed for pinging the server from hotwater
+        plumber::pr_get(
+            pr,
+            "/__hotwater__",
+            function() "running",
+            serializer = plumber::serializer_text(),
+            preempt = "__first__"
+        )
+        plumber::pr_hook(
+            pr,
+            "postserialize",
+            hook
+        )
     }
 }
 
@@ -30,10 +42,9 @@ postserialise_hotwater <- function(js) {
         if (length(value$error) > 0L) {
             return(value)
         }
-        if (grepl("text/html", value$headers[["Content-Type"]])) {
+        if (grepl("text/html", value$headers[["Content-Type"]])) { # nolint: nonportable_path_linter.
             value$headers[["Cache-Control"]] <- "no-cache"
-            value$body <- c(value$body, js) |>
-                paste0(collapse = "\n")
+            value$body <- paste(c(value$body, js), collapse = "\n")
         }
         value
     }
@@ -55,9 +66,9 @@ is_plumber_running <- function(engine) {
                 engine$config$host,
                 engine$config$port
             )
-            res <- httr2::request(url) |>
-                httr2::req_perform() |>
-                httr2::resp_status()
+            res <- httr2::resp_status(
+                httr2::req_perform(httr2::request(url))
+            )
             res == 200L
         },
         error = function(e) {

diff --git a/R/mirai.R b/R/mirai.R
@@ -1,3 +1,6 @@
+# this file contains the runner of the hotwater engine.
+# the "runner" is the subprocess that spawns the plumber API.
+
 new_runner <- function(engine) {
     stopifnot(is_engine(engine))
 
@@ -21,14 +24,13 @@ new_runner <- function(engine) {
             if (requireNamespace("box", quietly = TRUE)) {
                 box::set_script_path(mod)
             }
-            plumber::pr(path) |>
-                mdware() |>
-                plumber::pr_run(
-                    port = port,
-                    host = host,
-                    quiet = TRUE,
-                    debug = TRUE
-                )
+            plumber::pr_run(
+                mdware(plumber::pr(path)),
+                port = port,
+                host = host,
+                quiet = TRUE,
+                debug = TRUE
+            )
         },
         .args = list(
             port = port,
@@ -45,7 +47,10 @@ new_runner <- function(engine) {
 
     while (i < timeout && is_runner_alive(engine) && !is_plumber_running(engine)) {
         i <- i + 1L
-        try(cli::cli_progress_update(.envir = parent.frame(n = 1L)), silent = TRUE)
+        try(
+            cli::cli_progress_update(.envir = parent.frame(n = 1L)),
+            silent = TRUE
+        )
         Sys.sleep(0.1)
     }
 

diff --git a/R/run.R b/R/run.R
@@ -42,14 +42,12 @@
 #' @seealso [plumber::options_plumber],
 #' [plumber::get_option_or_env], [plumber::serializer_html]
 #'
-#' @examples
-#' if (interactive()) {
+#' @examplesIf interactive()
 #'  # start a hotwater session on port 9999
 #'  hotwater::run(
 #'    path = system.file("examples", "plumber.R", package = "hotwater"),
 #'    port = 9999L
 #'  )
-#' }
 #'
 #' @return NULL
 #' @export

diff --git a/R/script.R b/R/script.R
@@ -24,11 +24,11 @@ NULL
 
 common_install_paths <- list(
     unix = c(
-        "~/.local/bin/",
-        "~/bin/",
-        "/usr/bin/",
-        "/usr/local/bin/",
-        "/bin/"
+        file.path("~", ".local", "bin"),
+        file.path("~", "bin"),
+        file.path("usr", "bin"),
+        file.path("usr", "local", "bin"),
+        file.path("bin")
     ),
     windows = c() # does windows even work with this?
 )
@@ -38,18 +38,16 @@ common_install_paths <- list(
 #' If hotwater is installed, users may run `hotwater` from the command line
 #' rather than from an R terminal.
 #'
-#' @param install_folder \[default "~/.local/bin/"] folder to install hotwater
+#' @param install_folder folder to install hotwater
 #' script into. To run as expected, make sure that the folder supplied is on your
 #' `PATH` envar.
 #' @seealso [hotwater::uninstall_hotwater]
-#' @examples
-#' if (interactive()) {
+#' @examplesIf interactive()
 #'  hotwater::install_hotwater()
-#' }
 #' @return NULL
 #'
 #' @export
-install_hotwater <- function(install_folder = "~/.local/bin/") {
+install_hotwater <- function(install_folder) {
     p <- file.path(install_folder, "hotwater")
 
     if (file.exists(p)) {
@@ -70,16 +68,13 @@ install_hotwater <- function(install_folder = "~/.local/bin/") {
 
 #' Uninstall global hotwater script
 #'
-#' @param install_folder \[default "~/.local/bin/"] folder to uninstall hotwater
-#' from.
-#' @examples
-#' if (interactive()) {
-#'     hotwater::uninstall_hotwater()
-#' }
+#' @param install_folder folder to uninstall hotwater from.
+#' @examplesIf interactive()
+#'  hotwater::uninstall_hotwater()
 #' @seealso [hotwater::install_hotwater]
 #' @return NULL
 #' @export
-uninstall_hotwater <- function(install_folder = "~/.local/bin/") {
+uninstall_hotwater <- function(install_folder) {
     p <- file.path(install_folder, "hotwater")
     if (file.exists(p)) {
         success <- file.remove(p)