Skip to content

Commit 7dcfaf5

Browse files
authored
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
2 parents 12553cf + 33df7c0 commit 7dcfaf5

27 files changed

+242
-99
lines changed

.github/workflows/R-CMD-check.yaml

Lines changed: 1 addition & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -22,9 +22,7 @@ jobs:
2222
config:
2323
- {os: macos-latest, r: 'release'}
2424
- {os: windows-latest, r: 'release'}
25-
- {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'}
26-
- {os: ubuntu-latest, r: 'release'}
27-
- {os: ubuntu-latest, r: 'oldrel-1'}
25+
- {os: ubuntu-latest, r: 'release'}
2826

2927
env:
3028
GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}

.lintr

Lines changed: 43 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,49 @@ linters: linters_with_defaults(
33
implicit_integer_linter(),
44
indentation_linter(indent = 4L),
55
object_name_linter(styles = c("snake_case", "symbols"), regexes = character()),
6-
object_usage_linter = NULL
6+
unused_import_linter(
7+
allow_ns_usage = FALSE,
8+
except_packages = c("bit64", "data.table", "tidyverse"),
9+
interpret_glue = TRUE
10+
),
11+
object_usage_linter = NULL,
12+
sprintf_linter(),
13+
outer_negation_linter(),
14+
missing_argument_linter(),
15+
missing_package_linter(),
16+
duplicate_argument_linter(),
17+
length_test_linter(),
18+
redundant_equals_linter(),
19+
equals_na_linter(),
20+
unreachable_code_linter(),
21+
boolean_arithmetic_linter(),
22+
# package linters
23+
package_hooks_linter(),
24+
backport_linter(r_version = getRversion(), except = character()),
25+
yoda_test_linter(),
26+
expect_true_false_linter(),
27+
expect_comparison_linter(),
28+
expect_identical_linter(),
29+
expect_type_linter(),
30+
ifelse_censor_linter(),
31+
scalar_in_linter(),
32+
keyword_quote_linter(),
33+
nonportable_path_linter(lax = TRUE),
34+
paren_body_linter(),
35+
paste_linter(
36+
allow_empty_sep = FALSE,
37+
allow_to_string = FALSE,
38+
allow_file_path = c("double_slash", "always", "never")
39+
),
40+
class_equals_linter(),
41+
condition_message_linter(),
42+
nested_ifelse_linter(),
43+
string_boundary_linter(allow_grepl = FALSE),
44+
inner_combine_linter(),
45+
seq_linter(),
46+
sort_linter(),
47+
regex_subset_linter(),
48+
library_call_linter(allow_preamble = TRUE)
749
)
850
exclusions: list("man/", "inst/", "src/", ".vscode/", ".Rproj.user/", "R/import-standalone-obj-type.R", "R/import-standalone-types-check.R")
951
encoding: "UTF-8"

DESCRIPTION

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -14,8 +14,9 @@ Imports:
1414
httr2,
1515
nanonext,
1616
mirai,
17-
plumber,
18-
utils
17+
plumber (>= 0.4.0),
18+
utils,
19+
stats
1920
Suggests:
2021
box,
2122
docopt,

NAMESPACE

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -3,3 +3,4 @@
33
export(install_hotwater)
44
export(run)
55
export(uninstall_hotwater)
6+
importFrom(stats,start)

R/config.R

Lines changed: 7 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -12,7 +12,7 @@ new_config <- function(...) {
1212
new_port(host = host)
1313
ignore <- dots$ignore %||%
1414
utils::glob2rx(
15-
paste0(
15+
paste(
1616
c("*.sqlite", "*.git*"),
1717
collapse = "|"
1818
)
@@ -39,11 +39,15 @@ new_config <- function(...) {
3939
validate_config <- function(config) {
4040
stopifnot(is_config(config))
4141

42+
if (length(config$entry_path) > 1L) {
43+
error_invalid_path_length(config$entry_path)
44+
}
45+
4246
if (!file.exists(config$entry_path) || dir.exists(config$entry_path)) {
4347
error_invalid_path(config$entry_path)
4448
}
4549

46-
if (!is.null(config$dirs) && any(!dir.exists(config$dirs))) {
50+
if (!is.null(config$dirs) && !all(dir.exists(config$dirs))) {
4751
invalid <- config$dirs[!dir.exists(config$dirs)]
4852
error_invalid_dir(invalid)
4953
}
@@ -74,5 +78,5 @@ new_port <- function(used, host = "127.0.0.1") {
7478
}
7579

7680
is_config <- function(x) {
77-
"hotwater_config" %in% class(x)
81+
inherits(x, "hotwater_config")
7882
}

R/engine.R

Lines changed: 15 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,7 @@
1+
# this file contains the construction, destruction, and running of the engine.
2+
# "engine" refers to the superclass that contains the configuration, runner,
3+
# and publisher for the given hotwater. also, it's amusing to call it a "hotwater engine".
4+
15
new_engine <- function(config) {
26
stopifnot(is_config(config))
37
structure(
@@ -12,7 +16,7 @@ new_engine <- function(config) {
1216
config$host,
1317
config$socket_port
1418
),
15-
autostart = TRUE
19+
autostart = FALSE
1620
)
1721
)
1822
),
@@ -26,9 +30,7 @@ run_engine <- function(engine) {
2630
teardown_engine(engine)
2731
buildup_engine(engine)
2832
}
29-
on.exit({
30-
teardown_engine(engine)
31-
})
33+
on.exit({ teardown_engine(engine) }) # nolint: brace_linter.
3234

3335
cli_welcome()
3436
buildup_engine(engine)
@@ -42,7 +44,7 @@ run_engine <- function(engine) {
4244
)
4345

4446
repeat {
45-
Sys.sleep(0.05)
47+
Sys.sleep(0.05) # todo, allow this to be configured at some point
4648
current_state <- watch_directory(
4749
engine,
4850
current_state,
@@ -61,12 +63,18 @@ buildup_engine <- function(engine) {
6163

6264
cli_server_start_progress(engine)
6365
res <- new_runner(engine)
66+
67+
if (engine$publisher$listener[[1L]][["state"]] != "started") {
68+
start(engine$publisher$listener[[1L]])
69+
}
70+
6471
if (!res) {
6572
cli::cli_progress_done(result = "failed")
6673
} else {
6774
publish_browser_reload(engine)
6875
cli::cli_progress_done()
6976
}
77+
7078
cli_watching_directory(engine)
7179
}
7280

@@ -75,6 +83,7 @@ teardown_engine <- function(engine) {
7583

7684
cli_server_stop_progress()
7785
resp <- kill_engine(engine)
86+
7887
if (isTRUE(resp)) {
7988
cli::cli_process_done()
8089
} else {
@@ -83,5 +92,5 @@ teardown_engine <- function(engine) {
8392
}
8493

8594
is_engine <- function(x) {
86-
"hotwater_engine" %in% class(x)
95+
inherits(x, "hotwater_engine")
8796
}

R/errors.R

Lines changed: 14 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -8,11 +8,24 @@ new_hotwater_warning <- function(type) {
88

99
error_invalid_path <- function(path) {
1010
cli::cli_abort(
11-
"Invalid path: {.file {path}}",
11+
c(
12+
"Invalid path: {.file {path}}",
13+
x = "{.file {path}} not a valid path to a file"
14+
),
1215
class = new_hotwater_error("invalid_path")
1316
)
1417
}
1518

19+
error_invalid_path_length <- function(path) {
20+
cli::cli_abort(
21+
c(
22+
"Invalid path: {.file {path}}",
23+
x = "{.file {path}} must be length 1L"
24+
),
25+
class = new_hotwater_error("invalid_path_length")
26+
)
27+
}
28+
1629
error_invalid_dir <- function(dir) {
1730
cli::cli_abort(
1831
"Invalid directory: {.file {dir}}",

R/hotwater-package.R

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,7 @@
1+
#' @keywords internal
2+
"_PACKAGE"
3+
4+
## usethis namespace: start
5+
#' @importFrom stats start
6+
## usethis namespace: end
7+
NULL

R/middleware.R

Lines changed: 34 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -1,27 +1,39 @@
1+
# middleware for the engine, ensures that we can tell if the API is up and running,
2+
# and that we can embed some javascript to autoreload local web pages using the API.
3+
14
injection <- function(engine) {
2-
system.file("middleware", "injection.html", package = "hotwater", mustWork = TRUE) |>
3-
readLines() |>
4-
paste0(collapse = "\n") |>
5-
sprintf(engine$publisher$listener[[1L]]$url)
5+
injection_lines <- readLines(
6+
system.file("middleware", "injection.html", package = "hotwater", mustWork = TRUE)
7+
)
8+
9+
sprintf(
10+
paste(injection_lines, collapse = "\n"),
11+
engine$publisher$listener[[1L]]$url
12+
)
613
}
714

815
middleware <- function(engine) {
916
js <- injection(engine)
1017
hook <- postserialise_hotwater(js)
1118
function(pr) {
12-
pr |>
13-
# remove hotwater from the api spec
14-
plumber::pr_set_api_spec(function(spec) {
15-
spec$paths[["/__hotwater__"]] <- NULL
16-
spec
17-
}) |>
18-
# the dummy path is needed for pinging the server from hotwater
19-
plumber::pr_get(
20-
"/__hotwater__", function() "running",
21-
serializer = plumber::serializer_text(),
22-
preempt = "__first__"
23-
) |>
24-
plumber::pr_hook("postserialize", hook)
19+
# remove hotwater from the api spec
20+
plumber::pr_set_api_spec(pr, function(spec) {
21+
spec$paths[["/__hotwater__"]] <- NULL
22+
spec
23+
})
24+
# the dummy path is needed for pinging the server from hotwater
25+
plumber::pr_get(
26+
pr,
27+
"/__hotwater__",
28+
function() "running",
29+
serializer = plumber::serializer_text(),
30+
preempt = "__first__"
31+
)
32+
plumber::pr_hook(
33+
pr,
34+
"postserialize",
35+
hook
36+
)
2537
}
2638
}
2739

@@ -30,10 +42,9 @@ postserialise_hotwater <- function(js) {
3042
if (length(value$error) > 0L) {
3143
return(value)
3244
}
33-
if (grepl("text/html", value$headers[["Content-Type"]])) {
45+
if (grepl("text/html", value$headers[["Content-Type"]])) { # nolint: nonportable_path_linter.
3446
value$headers[["Cache-Control"]] <- "no-cache"
35-
value$body <- c(value$body, js) |>
36-
paste0(collapse = "\n")
47+
value$body <- paste(c(value$body, js), collapse = "\n")
3748
}
3849
value
3950
}
@@ -55,9 +66,9 @@ is_plumber_running <- function(engine) {
5566
engine$config$host,
5667
engine$config$port
5768
)
58-
res <- httr2::request(url) |>
59-
httr2::req_perform() |>
60-
httr2::resp_status()
69+
res <- httr2::resp_status(
70+
httr2::req_perform(httr2::request(url))
71+
)
6172
res == 200L
6273
},
6374
error = function(e) {

R/mirai.R

Lines changed: 14 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,6 @@
1+
# this file contains the runner of the hotwater engine.
2+
# the "runner" is the subprocess that spawns the plumber API.
3+
14
new_runner <- function(engine) {
25
stopifnot(is_engine(engine))
36

@@ -21,14 +24,13 @@ new_runner <- function(engine) {
2124
if (requireNamespace("box", quietly = TRUE)) {
2225
box::set_script_path(mod)
2326
}
24-
plumber::pr(path) |>
25-
mdware() |>
26-
plumber::pr_run(
27-
port = port,
28-
host = host,
29-
quiet = TRUE,
30-
debug = TRUE
31-
)
27+
plumber::pr_run(
28+
mdware(plumber::pr(path)),
29+
port = port,
30+
host = host,
31+
quiet = TRUE,
32+
debug = TRUE
33+
)
3234
},
3335
.args = list(
3436
port = port,
@@ -45,7 +47,10 @@ new_runner <- function(engine) {
4547

4648
while (i < timeout && is_runner_alive(engine) && !is_plumber_running(engine)) {
4749
i <- i + 1L
48-
try(cli::cli_progress_update(.envir = parent.frame(n = 1L)), silent = TRUE)
50+
try(
51+
cli::cli_progress_update(.envir = parent.frame(n = 1L)),
52+
silent = TRUE
53+
)
4954
Sys.sleep(0.1)
5055
}
5156

0 commit comments

Comments
 (0)