1has_names <- function(x) {
2  nms <- names(x)
3  if (is.null(nms)) {
4    rep(FALSE, length(x))
5  } else {
6    !(is.na(nms) | nms == "")
7  }
8}
9
10bind_args <- function(args, parent) {
11  assign_env <- parent
12  nms <- names(args)
13  for (i in seq_along(args)) {
14    eval_env <- assign_env
15    assign_env <- new.env(parent = eval_env)
16    delayed_assign(nms[[i]], args[[i]], eval.env = eval_env, assign.env = assign_env)
17  }
18  assign_env
19}
20
21# From tibble::recycle_columns
22recycle_columns <- function (x) {
23    if (length(x) == 0) {
24        return(x)
25    }
26    lengths <- vapply(x, NROW, integer(1))
27    if (any(lengths) == 0) {
28      return(character())
29    }
30
31    max <- max(lengths)
32    bad_len <- lengths != 1L & lengths != max
33    if (any(bad_len)) {
34      stop(call. = FALSE,
35        ngettext(max,
36          "Variables must be length 1",
37          paste0("Variables must be length 1 or ", max), domain = NA))
38    }
39    short <- lengths == 1
40    if (max != 1L && any(short)) {
41        x[short] <- lapply(x[short], rep, max)
42    }
43    x
44}
45
46# From https://github.com/hadley/colformat/blob/0a35999e7d77b9b3a47b4a04662d1c2625f929d3/R/styles.R#L19-L25
47colour_na <- function() {
48  grDevices::rgb(5, 5, 2, maxColorValue = 5)
49}
50
51style_na <- function(x) {
52  if (requireNamespace("crayon", quietly = TRUE)) {
53    crayon::style(x, bg = colour_na())
54  } else {
55    x # nocov
56  }
57}
58
59lengths <- function(x) {
60  vapply(x, length, integer(1L))
61}
62
63na_rows <- function(res) {
64  Reduce(`|`, lapply(res, is.na))
65}
66
67"%||%" <- function(x, y) if (is.null(x)) y else x # nocov
68
69drop_null <- function(x) {
70  x[!vapply(x, is.null, logical(1))]
71}
72
73# A version of delayedAssign which does _not_ use substitute
74delayed_assign <- function(x, value, eval.env = parent.frame(1), assign.env = parent.frame(1)) {
75  do.call(delayedAssign, list(x, value, eval.env, assign.env))
76}
77
78## @export
79compare.glue <- function(x, y, ...) {
80  if (identical(class(y), "character")) {
81    class(x) <- NULL
82  }
83  NextMethod("compare")
84}
85
86## @export
87compare_proxy.glue <- function(x, path = "x") {
88  class(x) <- NULL
89  NextMethod("compare_proxy")
90}
91