r-lib / usethis
1
can_overwrite <- function(path) {
2 1
  if (!file_exists(path)) {
3 1
    return(TRUE)
4
  }
5

6 1
  if (is_interactive()) {
7 0
    ui_yeah("Overwrite pre-existing file {ui_path(path)}?")
8
  } else {
9 1
    FALSE
10
  }
11
}
12

13
check_is_named_list <- function(x, nm = deparse(substitute(x))) {
14 1
  if (!is_list(x)) {
15 1
    bad_class <- paste(class(x), collapse = "/")
16 1
    ui_stop("{ui_code(nm)} must be a list, not {ui_value(bad_class)}.")
17
  }
18 1
  if (!is_dictionaryish(x)) {
19 1
    ui_stop(
20 1
      "Names of {ui_code(nm)} must be non-missing, non-empty, and non-duplicated."
21
    )
22
  }
23 1
  x
24
}
25

26
dots <- function(...) {
27 1
  eval(substitute(alist(...)))
28
}
29

30
asciify <- function(x) {
31 1
  stopifnot(is.character(x))
32 1
  gsub("[^a-zA-Z0-9_-]+", "-", x)
33
}
34

35
slug <- function(x, ext) {
36 1
  x_base <- path_ext_remove(x)
37 1
  x_ext <- path_ext(x)
38 1
  ext <- if (identical(tolower(x_ext), tolower(ext))) x_ext else ext
39 1
  path_ext_set(x_base, ext)
40
}
41

42
compact <- function(x) {
43 1
  is_empty <- vapply(x, function(x) length(x) == 0, logical(1))
44 1
  x[!is_empty]
45
}
46

47
check_installed <- function(pkg) {
48 1
  if (!is_installed(pkg)) {
49 0
    ui_stop("Package {ui_value(pkg)} required. Please install before re-trying.")
50
  }
51
}
52

53
is_installed <- function(pkg) {
54 1
  requireNamespace(pkg, quietly = TRUE)
55
}
56

57
interactive <- function() {
58 0
  ui_stop(
59 0
    "Internal error: use rlang's {ui_code('is_interactive()')} \\
60 0
     instead of {ui_code('base::interactive()')}"
61
  )
62
}
63

64
indent <- function(x, first = "  ", indent = first) {
65 1
  x <- gsub("\n", paste0("\n", indent), x)
66 1
  paste0(first, x)
67
}
68

69
isFALSE = function(x) {
70 1
  identical(x, FALSE)
71
}
72

73
isNA <- function(x) {
74 1
  length(x) == 1 && is.na(x)
75
}
76

77
path_first_existing <- function(...) {
78 1
  paths <- path(...)
79 1
  for (path in paths) {
80 1
    if (file_exists(path)) {
81 1
      return(path)
82
    }
83
  }
84

85 1
  NULL
86
}
87

88
is_online <- function(host) {
89 0
  !is.null(curl::nslookup(host, error = FALSE))
90
}
91

92 1
year <- function() format(Sys.Date(), "%Y")
93

94
pluck_lgl <- function(.x, ...) {
95 0
  as_logical(purrr::pluck(.x, ..., .default = NA))
96
}
97

98
pluck_chr <- function(.x, ...) {
99 0
  as_character(purrr::pluck(.x, ..., .default = NA))
100
}
101

102
pluck_int <- function(.x, ...) {
103 0
  as_integer(purrr::pluck(.x, ..., .default = NA))
104
}

Read our documentation on viewing source code .

Loading