is_null <- function(x) {identical(length(x), 0L)}
is_not_null <- function(x) {!is_null(x)}

is_scalar <- function(x) {identical(length(x), 1L)}

check_if_zero <- function(x, tolerance = sqrt(.Machine$double.eps)) {
  # this is the default tolerance used in all.equal
  abs(x) < tolerance
}

is_error <- function(x) {
  tryCatch(capture.output({out <- x}, type = "message"),
           error = function(e) {
             return(TRUE)
           }) |>
    suppressWarnings() |>
    suppressMessages() |>
    invisible()

  inherits(out, c("error", "try-error"))
}

is_whole_numeric <- function(x) {
  is_not_null(x) &&
    (is.integer(x) ||
       (is.numeric(x) && all(check_if_zero(x - trunc(x)))))
}

safe_any <- function(x) {
  x <- suppressWarnings(x)
  x[is.na(x)] <- FALSE
  any(x)
}
safe_all <- function(x) {
  x <- suppressWarnings(x)
  x[is.na(x)] <- FALSE
  all(x)
}

ansi_trim <- function(x, left = 0, right = 0) {
  n <- cli::ansi_nchar(x)

  cli::ansi_substr(x, left + 1L, n - right)
}
ansi_upper_first <- function(x) {
  starts_with_letters <- cli::ansi_grepl("^[[:alpha:]]", x)

  if (any(starts_with_letters)) {
    for (i in which(starts_with_letters)) {
      if (cli::ansi_nchar(x[i]) > 1L) {
        x[i] <- paste0(cli::ansi_toupper(cli::ansi_substr(x[i], 1L, 1L)),
                       cli::ansi_substr(x[i], 2L, cli::ansi_nchar(x[i])))

      }
      else {
        x[i] <- cli::ansi_toupper(x[i])
      }
    }
  }

  x
}
ansi_lower_first <- function(x) {
  starts_with_letters <- cli::ansi_grepl("^[[:alpha:]]", x)

  if (any(starts_with_letters)) {
    for (i in which(starts_with_letters)) {
      if (cli::ansi_nchar(x[i]) > 1L) {
        x[i] <- paste0(cli::ansi_tolower(cli::ansi_substr(x[i], 1L, 1L)),
                       cli::ansi_substr(x[i], 2L, cli::ansi_nchar(x[i])))

      }
      else {
        x[i] <- cli::ansi_tolower(x[i])
      }
    }
  }

  x
}

trim_final_punct <- function(x) {
  ends_with_punct <- cli::ansi_grepl("([.]|[?]|[!])$", x)

  if (any(ends_with_punct)) {
    x[ends_with_punct] <- ansi_trim(x[ends_with_punct], right = 1L)
  }

  x
}

any_apply <- function(X, FUN, ...) {
  FUN <- match.fun(FUN)
  if (!is.vector(X) || is.object(X)) {
    X <- as.list(X)
  }

  for (x in X) {
    if (isTRUE(FUN(x, ...))) {
      return(TRUE)
    }
  }

  FALSE
}
all_apply <- function(X, FUN, ...) {
  FUN <- match.fun(FUN)
  if (!is.vector(X) || is.object(X)) {
    X <- as.list(X)
  }

  for (x in X) {
    if (isFALSE(FUN(x, ...))) {
      return(FALSE)
    }
  }

  TRUE
}

# Makes an error an internal error, treated differently by
# and_or(), etc.
internal_arg <- function(expr) {
  rlang::try_fetch(expr,
                   error = function(e) {
                     class(e) <- c("internal_arg_error", class(e))
                     rlang::cnd_signal(e)
                   })
}

.msg_eval <- function(.msg, .call = rlang::caller_env()) {
  when_not_null(.msg,
                arg_character,
                .call = .call) |>
    internal_arg()

  .msg
}
