r-lib / cli
1

2
#' @importFrom assertthat assert_that on_failure<-
3

4
is_string <- function(x) {
5 1
  is.character(x) && length(x) == 1 && !is.na(x)
6
}
7

8
on_failure(is_string) <- function(call, env) {
9
  paste0(deparse(call$x), " is not a string (length 1 character)")
10
}
11

12
is_border_style <- function(x) {
13 1
  is_string(x) && x %in% rownames(box_styles())
14
}
15

16
on_failure(is_border_style) <- function(call, env) {
17
  paste0(deparse(call$x), " is not a border style (see ",
18
         sQuote("border_styles"), ")")
19
}
20

21
is_padding_or_margin <- function(x) {
22 1
  is.numeric(x) && length(x) %in% c(1, 4) && all(!is.na(x)) &&
23 1
    all(as.integer(x) == x)
24
}
25

26
on_failure(is_padding_or_margin) <- function(call, env) {
27
  paste0(deparse(call$x), " must be an integer of length one or four")
28
}
29

30
is_col <- function(x) {
31 1
  is.null(x) || is_string(x) || is.function(x)
32
}
33

34
on_failure(is_col) <- function(call, env) {
35
  paste0(deparse(call$x), " must be a color name, or a crayon style")
36
}
37

38
is_count <- function(x) {
39 1
  is.numeric(x) && length(x) == 1 && !is.na(x) && as.integer(x) == x &&
40 1
    x >= 0
41
}
42

43
on_failure(is_count) <- function(call, env) {
44
  paste0(deparse(call$x),
45
         " must be a count (length 1 non-negative integer)")
46
}
47

48
is_tree_style <- function(x) {
49 1
  is.list(x) &&
50 1
    length(x) == 4 &&
51 1
    !is.null(names(x)) &&
52 1
    all(sort(names(x)) == sort(c("h", "v", "l", "j"))) &&
53 1
    all(sapply(x, is_string))
54
}

Read our documentation on viewing source code .

Loading