1#! /usr/bin/env Rscript
2
3## To get the async package:
4## source("https://install-github.me/r-lib/async")
5
6setup_app <- function() {
7  theme <- list("url" = list(color = "blue"))
8  app <- cli::start_app(theme = theme, output = "stdout")
9}
10
11load_packages <- function() {
12  tryCatch({
13    library(cli)
14    library(async)
15    library(docopt) },
16    error = function(e) {
17      cli_alert_danger("The {.pkg async} and {.pkg docopt} packages are needed!")
18      q(save = "no", status = 1)
19    })
20}
21
22up <- function(urls, timeout = 5) {
23  load_packages()
24  setup_app()
25  chk_url <- async(function(url, ...) {
26    http_head(url, ...)$
27      then(function(res) {
28        if (res$status_code < 300) {
29          cli_alert_success("{.url {url}} ({res$times[['total']]}s)")
30        } else {
31          cli_alert_danger("{.url {url}} (HTTP {res$status_code})")
32        }
33      })$
34      catch(error = function(err) {
35        e <- if (grepl("timed out", err$message)) "timed out" else "error"
36        cli_alert_danger("{.url {url}} ({e})")
37      })
38  })
39
40  invisible(synchronise(
41    async_map(urls, chk_url, options = list(timeout = timeout))
42  ))
43}
44
45parse_arguments <- function() {
46
47  "Usage:
48  up.R [-t timeout] [URLS ...]
49  up.R -h | --help
50
51Options:
52  -t timeout   Timeout for giving up on a site, in seconds [default: 5].
53  -h --help    Print this help message
54
55Check if web sites are up.
56" -> doc
57
58  docopt(doc)
59}
60
61if (is.null(sys.calls())) {
62  load_packages()
63  opts <- parse_arguments()
64  up(opts$URLS, timeout = as.numeric(opts$t))
65}
66