
# ngettext() does extra work, this function is a simpler version
pluralise <- function(n, singular, plural) {
  if (n == 1) {
    singular
  } else {
    plural
  }
}
pluralise_len <- function(x, singular, plural) {
  pluralise(length(x), singular, plural)
}

bad <- function(..., .envir = parent.frame()) {
  glubort(NULL, ..., .envir = parent.frame())
}

bad_args <- function(args, ..., .envir = parent.frame()) {
  glubort(fmt_args(args), ..., .envir = .envir)
}

bad_pos_args <- function(pos_args, ..., .envir = parent.frame()) {
  glubort(fmt_pos_args(pos_args), ..., .envir = .envir)
}

bad_calls <- function(calls, ..., .envir = parent.frame()) {
  glubort(fmt_calls(calls), ..., .envir = .envir)
}

bad_named_calls <- function(named_calls, ..., .envir = parent.frame()) {
  glubort(fmt_named_calls(named_calls), ..., .envir = .envir)
}

bad_eq_ops <- function(named_calls, ..., .envir = parent.frame()) {
  glubort(fmt_wrong_eq_ops(named_calls), ..., .envir = .envir)
}

bad_cols <- function(cols, ..., .envir = parent.frame()) {
  glubort(fmt_cols(cols), ..., .envir = .envir)
}

bad_measures <- function(measures, ..., .envir = parent.frame()) {
  glubort(fmt_measures(measures), ..., .envir = .envir)
}

glubort <- function(header, ..., .envir = parent.frame(), .abort = abort) {
  text <- glue(..., .envir = .envir)
  if (!is_null(header)) text <- paste0(header, " ", text)
  .abort(text)
}

fmt_args <- function(x) {
  x <- parse_args(x)
  fmt_obj(x)
}

fmt_pos_args <- function(x) {
  args <- pluralise_len(x, "Argument", "Arguments")
  glue("{args} {fmt_comma(x)}")
}

fmt_calls <- function(...) {
  x <- parse_named_call(...)
  fmt_obj(x)
}

fmt_named_calls <- function(...) {
  x <- parse_named_call(...)
  fmt_named(x)
}

fmt_wrong_eq_ops <- function(...) {
  x <- parse_named_call(...)
  fmt_comma(
    paste0(fmt_obj1(names2(x)), " (", fmt_obj1(paste0(names2(x), " = ", x)), ")")
  )
}

fmt_cols <- function(x) {
  cols <- pluralise_len(x, "Column", "Columns")
  glue("{cols} {fmt_obj(x)}")
}

fmt_measures <- function(x) {
  measures <- pluralise_len(x, "Measure", "Measures")
  glue("{measures} {fmt_obj(x)}")
}

fmt_named <- function(x) {
  fmt_comma(paste0(fmt_obj1(names2(x)), " = ", x))
}

fmt_obj <- function(x) {
  fmt_comma(fmt_obj1(x))
}

fmt_obj1 <- function(x) {
  paste0("`", x, "`")
}

fmt_classes <- function(x) {
  paste(class(x), collapse = "/")
}

fmt_dims <- function(x) {
  paste0("[", paste0(x, collapse = " x "), "]")
}

fmt_comma <- function(...) {
  MAX_ITEMS <- 6L

  x <- paste0(...)
  if (length(x) > MAX_ITEMS) {
    length(x) <- MAX_ITEMS
    x[[MAX_ITEMS]] <- "..."
  }

  glue::glue_collapse(x, sep = ", ", last = " and ")
}

parse_args <- function(x) {
  # convert single formula to list of length 1
  x <- unlist(list(x), recursive = FALSE)
  is_fml <- map_lgl(x, is_formula)
  x[is_fml] <- map_chr(map(x[is_fml], "[[", 2), as_string)
  unlist(x)
}

parse_named_call <- function(x) {
  map_chr(x, quo_text)
}

bad_unknown_vars <- function(vars, unknown) {
  thing <- vars_pluralise_len(vars, unknown)
  abort(glue("Unknown { thing } { fmt_args(unknown) } "))
}
