Merge pull request #4 from ElianHugh/bug-fixes

- `%||%` 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)
- Fix windows tests

Add validation tests:
- check path length
- add more config validation tests

Author: ElianHugh

.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 }}

.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"

DESCRIPTION

@@ -14,8 +14,9 @@ Imports:
     httr2,
     nanonext,
     mirai,
-    plumber,
-    utils
+    plumber (>= 0.4.0),
+    utils,
+    stats
 Suggests:
     box,
     docopt,

NAMESPACE

@@ -3,3 +3,4 @@
 export(install_hotwater)
 export(run)
 export(uninstall_hotwater)
+importFrom(stats,start)

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")
 }

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(
@@ -12,7 +16,7 @@ new_engine <- function(config) {
                         config$host,
                         config$socket_port
                     ),
-                    autostart = TRUE
+                    autostart = FALSE
                 )
             )
         ),
@@ -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,18 @@ buildup_engine <- function(engine) {
 
     cli_server_start_progress(engine)
     res <- new_runner(engine)
+
+    if (engine$publisher$listener[[1L]][["state"]] != "started") {
+        start(engine$publisher$listener[[1L]])
+    }
+
     if (!res) {
         cli::cli_progress_done(result = "failed")
     } else {
         publish_browser_reload(engine)
         cli::cli_progress_done()
     }
+
     cli_watching_directory(engine)
 }
 
@@ -75,6 +83,7 @@ teardown_engine <- function(engine) {
 
     cli_server_stop_progress()
     resp <- kill_engine(engine)
+
     if (isTRUE(resp)) {
         cli::cli_process_done()
     } else {
@@ -83,5 +92,5 @@ teardown_engine <- function(engine) {
 }
 
 is_engine <- function(x) {
-    "hotwater_engine" %in% class(x)
+    inherits(x, "hotwater_engine")
 }

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}}",

R/hotwater-package.R

@@ -0,0 +1,7 @@
+#' @keywords internal
+"_PACKAGE"
+
+## usethis namespace: start
+#' @importFrom stats start
+## usethis namespace: end
+NULL

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) {

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)
     }