From cdcf0ea46ffc1410f97e108554f647243f75e3b4 Mon Sep 17 00:00:00 2001 From: "Elian H. Thiele-Evans" <60372411+ElianHugh@users.noreply.github.com> Date: Wed, 26 Jun 2024 17:56:27 +1000 Subject: [PATCH] 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 --- .github/workflows/R-CMD-check.yaml | 4 +- .lintr | 44 +++++++++++++++++++++- DESCRIPTION | 2 +- R/config.R | 10 +++-- R/engine.R | 15 +++++--- R/errors.R | 15 +++++++- R/middleware.R | 57 +++++++++++++++++------------ R/mirai.R | 23 +++++++----- R/run.R | 4 +- R/script.R | 29 ++++++--------- R/utils.R | 6 ++- R/zzz.R | 2 +- TODO.md | 5 +++ exec/hotwater | 2 +- inst/examples/plumber.R | 2 +- inst/middleware/injection.html | 4 +- man/install_hotwater.Rd | 8 ++-- man/run.Rd | 5 +-- man/uninstall_hotwater.Rd | 11 +++--- tests/testthat/_snaps/middleware.md | 2 +- tests/testthat/helpers.R | 8 ++-- tests/testthat/test-config.R | 33 +++++++++++++++-- tests/testthat/test-engine.R | 2 +- tests/testthat/test-script.R | 8 +++- 24 files changed, 204 insertions(+), 97 deletions(-) diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index 0f2fe08..f3ef4a8 100644 --- 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 index 017041b..32c57f4 100644 --- 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 index 750fc7b..f913081 100644 --- 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 index 61244cc..b6f08f1 100644 --- 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") } \ No newline at end of file diff --git a/R/engine.R b/R/engine.R index e3e2984..f0a0ab2 100644 --- 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") } \ No newline at end of file diff --git a/R/errors.R b/R/errors.R index b41d6b8..01bf4af 100644 --- 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 index 6ee2870..e5d0e9f 100644 --- 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 index c047181..84dd9d8 100644 --- 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 index 4fabefe..258e80e 100644 --- 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 index 9f0d742..abb41b4 100644 --- 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) diff --git a/R/utils.R b/R/utils.R index ad6b791..26c9409 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1,7 +1,9 @@ `%nin%` <- Negate(`%in%`) -`%||%` <- function(x, y) { - if (is.null(x)) y else x +if (!exists("%||%", baseenv())) { + `%||%` <- function(x, y) { + if (is.null(x)) y else x + } } `%|NA|%` <- function(x, y) { # nolint: object_name_linter. diff --git a/R/zzz.R b/R/zzz.R index fef93ed..c88566d 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -1,4 +1,4 @@ -.onLoad <- function(...) { +.onLoad <- function(lib, pkg) { ns <- asNamespace("hotwater") if (is.null(ns[["hotwater"]])) { ns[["hotwater"]] <- new.env(parent = ns) diff --git a/TODO.md b/TODO.md index bb97b75..1cd663b 100644 --- a/TODO.md +++ b/TODO.md @@ -15,3 +15,8 @@ ## 4 - The CLI messages are a bit all over the place, and errors don't always cause the progress bar to fail + +## 5 + +- An error doesn't always cause hotwater to attempt to restart. Should it? An error can indicate that the API has to be changed +before trying again diff --git a/exec/hotwater b/exec/hotwater index 5e6eaa1..7d97e4d 100644 --- a/exec/hotwater +++ b/exec/hotwater @@ -1,7 +1,7 @@ #!/usr/bin/env Rscript if (!requireNamespace("hotwater", quietly = TRUE)) { - cli::cli_inform("Bootstrapping hotwater...") + base::message("Bootstrapping hotwater...") utils::install.packages("hotwater", repos = "https://elianhugh.r-universe.dev") } diff --git a/inst/examples/plumber.R b/inst/examples/plumber.R index f612fe1..a5411da 100644 --- a/inst/examples/plumber.R +++ b/inst/examples/plumber.R @@ -1,5 +1,5 @@ #' @get / #' @serializer html function() { - "Hello world." + "Hello, world." } diff --git a/inst/middleware/injection.html b/inst/middleware/injection.html index 0884d8b..2e657b7 100644 --- a/inst/middleware/injection.html +++ b/inst/middleware/injection.html @@ -3,12 +3,12 @@ if (!document.getElementById('hotwater-reloader')) { document.currentScript.id = "hotwater-reloader" document.body.appendChild(document.currentScript) - var ws = new WebSocket('%s', ['pub.sp.nanomsg.org']); + let ws = new WebSocket('%s', ['pub.sp.nanomsg.org']); ws.onmessage = () => { window.location.reload(); }; } else { - var checker = document.currentScript; + let checker = document.currentScript; checker.parentNode.removeChild(checker); } })(); diff --git a/man/install_hotwater.Rd b/man/install_hotwater.Rd index 11c3194..3c912d7 100644 --- a/man/install_hotwater.Rd +++ b/man/install_hotwater.Rd @@ -4,10 +4,10 @@ \alias{install_hotwater} \title{Install global hotwater script} \usage{ -install_hotwater(install_folder = "~/.local/bin/") +install_hotwater(install_folder) } \arguments{ -\item{install_folder}{[default "~/.local/bin/"] folder to install hotwater +\item{install_folder}{folder to install hotwater script into. To run as expected, make sure that the folder supplied is on your \code{PATH} envar.} } @@ -16,9 +16,9 @@ If hotwater is installed, users may run \code{hotwater} from the command line rather than from an R terminal. } \examples{ -if (interactive()) { +\dontshow{if (interactive()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} hotwater::install_hotwater() -} +\dontshow{\}) # examplesIf} } \seealso{ \link{uninstall_hotwater} diff --git a/man/run.Rd b/man/run.Rd index 38b05d5..4b52c36 100644 --- a/man/run.Rd +++ b/man/run.Rd @@ -45,14 +45,13 @@ inject a websocket into the HTML client that listens for the plumber server refresh. } \examples{ -if (interactive()) { +\dontshow{if (interactive()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} # start a hotwater session on port 9999 hotwater::run( path = system.file("examples", "plumber.R", package = "hotwater"), port = 9999L ) -} - +\dontshow{\}) # examplesIf} } \seealso{ \link[plumber:options_plumber]{plumber::options_plumber}, diff --git a/man/uninstall_hotwater.Rd b/man/uninstall_hotwater.Rd index 4f8cf8a..a3c5597 100644 --- a/man/uninstall_hotwater.Rd +++ b/man/uninstall_hotwater.Rd @@ -4,19 +4,18 @@ \alias{uninstall_hotwater} \title{Uninstall global hotwater script} \usage{ -uninstall_hotwater(install_folder = "~/.local/bin/") +uninstall_hotwater(install_folder) } \arguments{ -\item{install_folder}{[default "~/.local/bin/"] folder to uninstall hotwater -from.} +\item{install_folder}{folder to uninstall hotwater from.} } \description{ Uninstall global hotwater script } \examples{ -if (interactive()) { - hotwater::uninstall_hotwater() -} +\dontshow{if (interactive()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} + hotwater::uninstall_hotwater() +\dontshow{\}) # examplesIf} } \seealso{ \link{install_hotwater} diff --git a/tests/testthat/_snaps/middleware.md b/tests/testthat/_snaps/middleware.md index 0fe2f60..54192f2 100644 --- a/tests/testthat/_snaps/middleware.md +++ b/tests/testthat/_snaps/middleware.md @@ -3,5 +3,5 @@ Code injection(dummy_engine) Output - [1] "" + [1] "" diff --git a/tests/testthat/helpers.R b/tests/testthat/helpers.R index ae5f912..f08f11a 100644 --- a/tests/testthat/helpers.R +++ b/tests/testthat/helpers.R @@ -1,12 +1,12 @@ new_test_engine <- function() { - new_engine( - new_config( - path = system.file("examples", "plumber.R", package = "hotwater") - ) + config <- new_config( + path = system.file("examples", "plumber.R", package = "hotwater") ) + new_engine(config) } cleanup_test_engine <- function(engine) { kill_engine(engine) close(engine$publisher) + Sys.sleep(0.5) } diff --git a/tests/testthat/test-config.R b/tests/testthat/test-config.R index e4318ae..0f3adb7 100644 --- a/tests/testthat/test-config.R +++ b/tests/testthat/test-config.R @@ -1,6 +1,33 @@ test_that("config is validated", { - bad <- new_config( - path = "." + bad <- new_config(path = ".") + bad2 <- new_config( + path = c( + system.file("examples", "plumber.R", package = "hotwater"), + system.file("examples", "plumber.R", package = "hotwater") + ) + ) + bad3 <- new_config( + path = system.file("examples", "plumber.R", package = "hotwater"), + dirs = system.file("examples", "plumber.R", package = "hotwater") + ) + bad4 <- new_config( + path = system.file("examples", "plumber.R", package = "hotwater"), + port = "not a port" + ) + expect_error( + validate_config(bad), + class = new_hotwater_error("invalid_path") + ) + expect_error( + validate_config(bad2), + class = new_hotwater_error("invalid_path_length") + ) + expect_error( + validate_config(bad3), + class = new_hotwater_error("invalid_dir") + ) + expect_error( + validate_config(bad4), + class = new_hotwater_error("invalid_port") ) - expect_error(validate_config(bad)) }) diff --git a/tests/testthat/test-engine.R b/tests/testthat/test-engine.R index 341fe0d..2520b09 100644 --- a/tests/testthat/test-engine.R +++ b/tests/testthat/test-engine.R @@ -8,7 +8,7 @@ test_that("engine reuse", { ) expect_true( should_reuse_engine( - old = engine$config, + old_config = engine$config, new_config( dirs = engine$config$dirs, path = engine$config$entry_path, diff --git a/tests/testthat/test-script.R b/tests/testthat/test-script.R index 403aa0e..f3504fd 100644 --- a/tests/testthat/test-script.R +++ b/tests/testthat/test-script.R @@ -3,7 +3,9 @@ test_that("hotwater install/uninstall works", { local({ hw_install_folder <- withr::local_tempdir("install_path") # should work first time - expect_no_error(install_hotwater(hw_install_folder)) + expect_no_error( + suppressMessages(install_hotwater(hw_install_folder)) + ) # error because file already exists expect_error( install_hotwater(hw_install_folder), @@ -11,7 +13,9 @@ test_that("hotwater install/uninstall works", { ) # work first time - expect_no_error(uninstall_hotwater(hw_install_folder)) + expect_no_error( + suppressMessages(uninstall_hotwater(hw_install_folder)) + ) # warning because no file exists expect_warning( uninstall_hotwater(hw_install_folder),