#' Default input tests
#'
#' This function provides a selection of potentially problematic inputs by
#' class. List inputs are very limited by design, as they can be automatically
#' generated by setting `listify_what = TRUE` in [fuzz].
#'
#' @param use Names of input classes to use. Valid names are "all" (default),
#'        "scalar", "numeric", "integer", "logical", "character", "factor",
#'        "data.frame", "matrix", "array", "date", "time", "raw", "na" and
#'        "list". A vector of valid classes can be retrieved programmatically
#'        by setting this argument to "help".
#' @param skip Names of input classes to skip. Overrides any classes selected
#'        via the `use` argument.
#'
#' @return
#' A named list of inputs corresponding to the input classes selected, or
#' a character vector of valid input classes if `use = "help"`.
#'
#' @examples
#' ## only the scalar and numeric tests
#' inputs1 <- test_inputs(use = c("scalar", "numeric"))
#'
#' ## everything but the data, raw and list tests
#' inputs2 <- test_inputs(skip = c("date", "raw", "list"))
#'
#' ## print the valid input classes
#' test_inputs("help")
#'
#' @seealso [fuzz]
#'
#' @export
test_inputs <- function(use = "all", skip = "") {
  validate_class(use, "character", remove_empty = TRUE)
  validate_class(skip, "character")
  inputs <- c("scalar_inputs",
              "numeric_inputs",
              "integer_inputs",
              "logical_inputs",
              "character_inputs",
              "factor_inputs",
              "data.frame_inputs",
              "matrix_inputs",
              "array_inputs",
              "date_inputs",
              "time_inputs",
              "raw_inputs",
              "na_inputs",
              "list_inputs")
  valid <- names(inputs) <- gsub("_inputs", "", inputs)
  "help" %in% use && return(c("all", valid))
  if ("all" %in% use)
    use <- valid
  use <- setdiff(use[use %in% valid], skip)
  length(use) == 0 &&
    fuzz_error("No valid tests selected, valid names are:",
               toString(sQuote(c("all", valid), q = FALSE)),
               from = "test_inputs")
  unlist(lapply(use, function(x) eval(call(inputs[x]))), recursive = FALSE)
}

#' Add names to a list of inputs
#'
#' This function can be used to generate automatically pretty names in a
#' list of custom input objects. This can improve the output, especially when
#' structures such as data frames, matrices, and more complex objects are
#' involved.
#'
#' @param ... Objects, possibly named.
#'
#' @return
#' A named list containing the evaluated arguments. For unnamed arguments,
#' names are generated by deparsing the unevaluated inputs.
#'
#' @examples
#' namify(data.frame(a = 1, b = 2))
#'
#' @seealso [fuzz]
#'
#' @noRd
namify <- function(...) {
  what <- substitute(list(...))

  ## use deparsed names for unnamed objects
  idx.empty <- if (is.null(names(what))) seq_along(what) else names(what) == ""
  names(what)[idx.empty] <- vapply(what, deparse, character(1), nlines = 1)[idx.empty]

  ## evaluate the arguments and remove the list() element added by substitute()
  lapply(what, eval)[-1]
}

scalar_inputs <- function() {
  namify(
      3L,
      0L,
      -4L,
      .Machine$integer.max,
      .Machine$double.xmin,
      .Machine$double.xmax,
      1.2,
      -2.5,
      6i,
      NaN,
      Inf,
      NULL
  )
}

numeric_inputs <- function() {
  namify(
      c(1.309605, 0.585381, -0.461072),
      c(-1, 0, NaN, 1e4),
      c(Inf, -0.5, 1234),
      c(0, 0),
      c(0, NA),
      numeric()
  )
}

integer_inputs <- function() {
  namify(
      -1:3,
      c(0L, NA),
      integer()
  )
}

logical_inputs <- function() {
  namify(
      TRUE,
      c(TRUE, NA, FALSE),
      logical()
  )
}

character_inputs <- function() {
  namify(
      "",
      "a test",
      c("", "B", ""),
      c("A", NA, "7", "+"),
      character()
  )
}

factor_inputs <- function() {
  namify(
      factor(""),
      factor(c("A", NA, "7", "+")),
      factor(c("a", NA, "c", "d"), levels = letters[1:4]),
      factor(c(NA, NA, NA, NA)),
      factor()
  )
}

date_inputs <- function() {
  namify(
      as.Date(NA),
      as.Date(NULL),
      as.Date(0),
      as.Date(c("2025-01-01", NA, "930-12-31")),
      Sys.Date()
  )
}

time_inputs <- function() {
  namify(
      as.POSIXct(NA),
      as.POSIXct(NULL),
      as.POSIXct("2065-01-01 00:00:00"),
      as.POSIXct(0, origin = "1970-01-01"),
      as.POSIXlt(Sys.time()),
      Sys.time()
  )
}

data.frame_inputs <- function() {
  namify(
      data.frame(a = NA),
      data.frame(a = letters),
      data.frame(a = 1:10, b = NA),
      data.frame(a = -1:1, b = Inf),
      data.frame(a = c(12, -2.1, 7), b = c(1.34, 2.28, 0.0), c = (-1:1 + 0.1)),
      datasets::iris[0, ],
      datasets::iris[, 0],
      datasets::iris[1, , drop = FALSE],
      datasets::iris[, 1, drop = FALSE],
      data.frame()
  )
}

matrix_inputs <- function() {
  namify(
      matrix(0, 0, 0),
      matrix(1, 1, 0),
      matrix(1, 0, 1),
      matrix(c(1.995874, 1.225707, -0.565287, -2.120309, 0.236326), 1, 5),
      matrix(c(-1.005770, 0.589365, 0.955131, -0.972982, 1.058721), 5, 1),
      matrix(c(1:7, NA, -1:-4), 3, 4),
      matrix(c(-1:6, Inf), 3, 3),
      matrix(letters, 13, 2),
      matrix()
  )
}

array_inputs <- function() {
  namify(
      array(0, c(0, 0, 0)),
      array(1, c(1, 1, 0)),
      array(1, c(0, 1, 0)),
      array(c(0.72350, -0.19754, 1.67188, -0.62163, -0.84149), c(1, 1, 5)),
      array(c(-0.16868, 0.86973, -0.46976, 0.32157, -0.43558), c(1, 5, 1)),
      array(c(-0.57441, -1.9585, -0.24757, -0.2467, -2.04617), c(5, 1, 1)),
      array(c(1:7, NA), c(2, 4, 1)),
      array(c(1:5, NA, NA), c(2, 4, 2)),
      array(c(1:3, Inf, 12.5), c(2, 4, 2)),
      array()
  )
}

raw_inputs <- function() {
  namify(
      charToRaw("0"),
      charToRaw(NA_character_),
      charToRaw("abc"),
      raw()
  )
}

na_inputs <- function() {
  namify(
      NA_real_,
      NA_integer_,
      NA_character_,
      NA
  )
}

list_inputs <- function() {
  namify(
      list(3),
      list(a = c(1, 2, 3), b = letters),
      list()
  )
}
