tests/testthat/test-widgets-extra.R

In termr: Modern Reactive Terminal Applications with Data Workflows

test_that("checkbox toggles with keys and mouse and sends messages", {
  got <- logical()
  cb <- checkbox("Enable logs", id = "cb")
  a <- app(vertical(cb), on("checkbox.changed", function(event, app) got <<- c(got, event$data$value)))
  pilot <- test_app(a, 20, 2)
  expect_identical(pilot$screen_text()[[1]], "[ ] Enable logs     ")
  pilot$press("space")
  expect_true(cb$value)
  expect_match(pilot$screen_text()[[1]], "^\\[x\\]")
  pilot$click("#cb")
  pilot$press("enter")
  expect_identical(got, c(TRUE, FALSE, TRUE))
  expect_error(checkbox("x", value = "yes"), "TRUE or FALSE")
})

test_that("radio sets keep a single selection", {
  got <- character()
  rs <- radio_set(radio_button("CSV", "csv"), radio_button("JSON", "json", id = "json"), radio_button("XML", "xml"),
                  selected = "csv", id = "fmt")
  a <- app(vertical(rs), on("radio_set.changed", function(event, app) got <<- c(got, event$data$value)))
  pilot <- test_app(a, 20, 4)
  expect_identical(rs$value, "csv")
  dot <- "\u2022"
  expect_identical(substr(pilot$screen_text()[[1]], 1, 3), paste0("(", dot, ")"))
  pilot$press("down")
  expect_identical(rs$value, "json")
  expect_identical(a$focused$id, "json")
  pilot$press("down", "down")
  expect_identical(rs$value, "csv")
  pilot$click(3, 3)
  expect_identical(rs$value, "xml")
  expect_identical(sum(vapply(rs$children, function(b) b$selected, logical(1))), 1L)
  expect_identical(got, c("json", "xml", "csv", "xml"))
  expect_error(rs$value <- "nope", "No radio button")
  expect_error(radio_set(label("x")), "radio_button")
})

test_that("dropdown opens a list, selects and closes", {
  got <- NULL
  dd <- dropdown(c(Comma = "csv", JSON = "json", Parquet = "parquet"), id = "fmt")
  a <- app(vertical(dd, label("below", id = "below")), on("dropdown.changed", function(event, app) got <<- event$data))
  pilot <- test_app(a, 30, 12)
  expect_match(pilot$screen_text()[[2]], "Select")
  pilot$press("enter")
  expect_true(inherits(a$screen, "DropdownScreen"))
  text <- pilot$screen_text()
  expect_match(text[[5]], "Comma")
  expect_match(text[[6]], "JSON")
  pilot$press("down", "enter")
  expect_false(inherits(a$screen, "DropdownScreen"))
  expect_identical(dd$value, "json")
  expect_identical(got, list(value = "json", label = "JSON"))
  expect_match(pilot$screen_text()[[2]], "JSON")
  expect_identical(a$focused$id, "fmt")
  # Escape and clicking outside close without changing the value.
  pilot$press("enter", "escape")
  expect_identical(dd$value, "json")
  pilot$click("#fmt")
  pilot$click(29, 11)
  expect_false(inherits(a$screen, "DropdownScreen"))
  # Mouse selection.
  pilot$click("#fmt")
  pilot$click(5, 7)
  expect_identical(dd$value, "parquet")
  expect_error(dd$value <- "xls", "not one of the choices")
})

test_that("option lists highlight and select", {
  got <- character()
  ol <- option_list(c("a", "b", "c"), id = "ol")
  a <- app(ol, on("option_list.selected", function(event, app) got <<- c(got, event$data$value)))
  pilot <- test_app(a, 10, 3)
  pilot$press("down", "enter")
  expect_identical(got, "b")
  expect_identical(ol$value, "b")
  ol$value <- "c"
  expect_identical(ol$cursor, 3L)
})

test_that("progress bars render determinate and indeterminate states", {
  pb <- progress_bar(0.5)
  buf <- render_widget(pb, 15, 1)
  text <- buf$to_text()
  expect_match(text, " 50%$")
  expect_identical(substr(text, 1, 5), strrep("\u2501", 5))
  expect_identical(buf$get_cell(1, 1)$fg, "bright_cyan")
  expect_identical(buf$get_cell(6, 1)$fg, "bright_black")
  pb$advance(0.5)
  expect_identical(pb$value, 1)
  expect_identical(render_widget(pb, 15, 1)$get_cell(1, 1)$fg, "bright_green")
  busy <- progress_bar(NA)
  pilot <- test_app(app(busy), 20, 1)
  colours <- function() pilot$driver$terminal$screen$fg[1, ]
  first <- colours()
  pilot$advance(0.3)
  # The moving segment is the same character in another colour.
  expect_false(identical(first, colours()))
  expect_error(progress_bar(-1), "non-negative")
})

test_that("spinners animate on a timer and stop when removed", {
  sp <- spinner("Loading", type = "line", interval = 0.1)
  a <- app(vertical(sp))
  pilot <- test_app(a, 20, 2)
  expect_identical(pilot$screen_text()[[1]], "- Loading           ")
  pilot$advance(0.1)
  expect_identical(substr(pilot$screen_text()[[1]], 1, 1), "\\")
  sp$spinning <- FALSE
  pilot$step()
  expect_identical(substr(pilot$screen_text()[[1]], 1, 1), " ")
})

test_that("rules, sparklines, metrics and key/value lists render", {
  expect_identical(render_widget(rule(title = "Results"), 15, 1)$to_text(), "\u2500\u2500\u2500 Results \u2500\u2500\u2500")
  v <- render_widget(horizontal(label("a"), rule("vertical"), label("b"), style = style(height = 2)), 3, 2)
  expect_identical(v$to_text(), c("a\u2502b", " \u2502 "))
  s <- sparkline(c(0, 1, 2, 3, 4, 5, 6, 7, NA))
  expect_identical(render_widget(s, 9, 1)$to_text(), "\u2581\u2582\u2583\u2584\u2585\u2586\u2587\u2588 ")
  s$push(c(7, 0))
  expect_identical(length(s$data), 11L)
  expect_identical(sparkline_text(1:10, 4), sparkline_text(7:10, 4))
  expect_identical(nchar(sparkline_text(1:10, 4, summary = "mean")), 4L)
  expect_identical(sparkline_text(c(5, 5), 2), "\u2584\u2584")
  m <- metric("Accuracy", 0.943, delta = 0.012)
  text <- render_widget(m, 20, 4)$to_text()
  expect_match(text[[2]], "Accuracy")
  expect_match(text[[3]], "0.943 +\u25b2 0.012")
  m$update(0.9, delta = -0.043)
  expect_match(render_widget(m, 20, 4)$to_text()[[3]], "\u25bc 0.043")
  m2 <- metric("Rows", 1234567)
  expect_match(render_widget(m2, 20, 4)$to_text()[[3]], "1,234,567")
  kv <- key_value(list(Rows = 32, Source = "mtcars"))
  expect_identical(render_widget(kv, 16, 2)$to_text(), c("Rows    32      ", "Source  mtcars  "))
  expect_error(key_value(list(1, 2)), "named")
})

test_that("log views append, cap their size and follow the end", {
  logs <- log_view(max_lines = 5, id = "log")
  a <- app(logs)
  pilot <- test_app(a, 20, 3)
  for (i in 1:4) logs$write("line ", i)
  pilot$step()
  expect_identical(pilot$screen_text()[[3]], "line 4             \u2588")
  logs$write("bad\nworse", level = "error")
  pilot$step()
  expect_identical(logs$lines, c("line 2", "line 3", "line 4", "bad", "worse"))
  expect_identical(pilot$driver$terminal$screen$get_cell(1, 3)$fg, "bright_red")
  pilot$press("up", "up")
  expect_false(logs$at_end())
  logs$write("more")
  pilot$step()
  expect_false(any(grepl("more", pilot$screen_text())))
  pilot$press("end")
  logs$write("latest")
  pilot$step()
  expect_identical(substr(pilot$screen_text()[[3]], 1, 6), "latest")
  logs$pause()
  logs$write("hidden")
  pilot$step()
  expect_false(any(grepl("hidden", pilot$screen_text())))
  logs$resume()
  pilot$step()
  expect_match(pilot$screen_text()[[3]], "hidden")
  logs$clear()
  expect_length(logs$lines, 0)
  expect_error(logs$write("x", level = "fatal"), "level")
})