#' Find the prototype of a set of vectors
#'
#' @description
#' - `vec_ptype()` returns the [unfinalised][vec_ptype_finalise] prototype of a
#'   single vector.
#'
#' - `vec_ptype_common()` returns the common type of multiple vectors. By
#'   default, this is [finalised][vec_ptype_finalise] for immediate usage, but
#'   can optionally be left unfinalised for advanced common type determination.
#'
#' - `vec_ptype_show()` nicely prints the common type of any number of inputs,
#'   and is designed for interactive exploration.
#'
#' @inheritParams rlang::args_error_context
#'
#' @param x A vector
#'
#' @param ... For `vec_ptype()`, these dots are for future extensions and must
#'   be empty.
#'
#'   For `vec_ptype_common()` and `vec_ptype_show()`, vector inputs.
#'
#' @param x_arg Argument name for `x`. This is used in error messages to inform
#'   the user about the locations of incompatible types.
#'
#' @param .ptype If `NULL`, the default, the output type is determined by
#'   computing the common type across all elements of `...`.
#'
#'   Alternatively, you can supply `.ptype` to give the output known type.
#'   If `getOption("vctrs.no_guessing")` is `TRUE` you must supply this value:
#'   this is a convenient way to make production code demand fixed types.
#'
#' @param .finalise Should `vec_ptype_common()` [finalise][vec_ptype_finalise]
#'   its output?
#'
#'   - If `TRUE`, [vec_ptype_finalise()] is called on the final `ptype` before
#'     it is returned. Practically this has the effect of converting any
#'     types from [unspecified] to logical.
#'
#'   - If `FALSE`, [unspecified] types are left unfinalised, which can be useful
#'     for advanced cases where you combine one common type result with another
#'     type via [vec_ptype2()]. Note that you must manually call
#'     [vec_ptype_finalise()] on the final `ptype` before supplying it to any
#'     other vctrs functions.
#'
#' @return `vec_ptype()` and `vec_ptype_common()` return a prototype
#'   (a size-0 vector).
#'
#' @section `vec_ptype()`:
#'
#' `vec_ptype()` returns [size][vec_size] 0 vectors potentially
#' containing attributes but no data. Generally, this is just
#' `vec_slice(x, 0L)`, but some inputs require special
#' handling.
#'
#' * While you can't slice `NULL`, the prototype of `NULL` is
#'   itself. This is because we treat `NULL` as an identity value in
#'   the `vec_ptype2()` monoid.
#'
#' * The prototype of logical vectors that only contain missing values
#'   is the special [unspecified] type, which can be coerced to any
#'   other 1d type. This allows bare `NA`s to represent missing values
#'   for any 1d vector type. [Finalising][vec_ptype_finalise] this type
#'   converts it from unspecified back to logical.
#'
#' See [internal-faq-ptype2-identity] for more information about
#' identity values.
#'
#' `vec_ptype()` is a _performance_ generic. It is not necessary to implement it
#' because the default method will work for any vctrs type. However the default
#' method builds around other vctrs primitives like `vec_slice()` which incurs
#' performance costs. If your class has a static prototype, you might consider
#' implementing a custom `vec_ptype()` method that returns a constant. This will
#' improve the performance of your class in many cases ([common
#' type][vec_ptype2] imputation in particular).
#'
#' Because it may contain unspecified vectors, the prototype returned by
#' `vec_ptype()` is said to be __unfinalised__. Call [vec_ptype_finalise()] to
#' finalise it.
#'
#' @section `vec_ptype_common()`:
#'
#' `vec_ptype_common()` first finds the prototype of each input, then
#' successively calls [vec_ptype2()] to find a common type. It returns a
#' [finalised][vec_ptype_finalise] prototype by default, but can optionally be
#' left unfinalised for advanced common type determination.
#'
#' @section Dependencies of `vec_ptype()`:
#' - [vec_slice()] for returning an empty slice
#'
#' @section Dependencies of `vec_ptype_common()`:
#' - [vec_ptype2()]
#' - [vec_ptype_finalise()]
#'
#' @export
#' @examples
#' # Unknown types ------------------------------------------
#' vec_ptype_show()
#' vec_ptype_show(NULL)
#'
#' # Vectors ------------------------------------------------
#' vec_ptype_show(1:10)
#' vec_ptype_show(letters)
#' vec_ptype_show(TRUE)
#'
#' vec_ptype_show(Sys.Date())
#' vec_ptype_show(Sys.time())
#' vec_ptype_show(factor("a"))
#' vec_ptype_show(ordered("a"))
#'
#' # Matrices -----------------------------------------------
#' # The prototype of a matrix includes the number of columns
#' vec_ptype_show(array(1, dim = c(1, 2)))
#' vec_ptype_show(array("x", dim = c(1, 2)))
#'
#' # Data frames --------------------------------------------
#' # The prototype of a data frame includes the prototype of
#' # every column
#' vec_ptype_show(iris)
#'
#' # The prototype of multiple data frames includes the prototype
#' # of every column that in any data frame
#' vec_ptype_show(
#'   data.frame(x = TRUE),
#'   data.frame(y = 2),
#'   data.frame(z = "a")
#' )
#'
#' # Finalisation -------------------------------------------
#'
#' # `vec_ptype()` and `vec_ptype2()` return unfinalised ptypes so that they
#' # can be coerced to any other type
#' vec_ptype(NA)
#' vec_ptype2(NA, NA)
#'
#' # By default `vec_ptype_common()` finalises so that you can use its result
#' # directly in other vctrs functions
#' vec_ptype_common(NA, NA)
#'
#' # You can opt out of finalisation to make it work like `vec_ptype()` and
#' # `vec_ptype2()` with `.finalise = FALSE`, but don't forget that you must
#' # call `vec_ptype_finalise()` manually if you do so!
#' vec_ptype_common(NA, NA, .finalise = FALSE)
#' vec_ptype_finalise(vec_ptype_common(NA, NA, .finalise = FALSE))
#'
#' # This can be useful in rare scenarios, like including a separate `default`
#' # argument in the ptype computation
#' xs <- list(NA, NA)
#' default <- "a"
#' try(vec_ptype2(vec_ptype_common(!!!xs), default))
#' vec_ptype2(vec_ptype_common(!!!xs, .finalise = FALSE), default)
vec_ptype <- function(x, ..., x_arg = "", call = caller_env()) {
  check_dots_empty0(...)
  return(.Call(ffi_ptype, x, x_arg, environment()))
  UseMethod("vec_ptype")
}

#' @export
#' @rdname vec_ptype
vec_ptype_common <- function(
  ...,
  .ptype = NULL,
  .finalise = TRUE,
  .arg = "",
  .call = caller_env()
) {
  .External2(ffi_ptype_common, list2(...), .ptype, .finalise)
}

vec_ptype_common_params <- function(
  ...,
  .ptype = NULL,
  .finalise = TRUE,
  .fallback_opts = fallback_opts(),
  .arg = "",
  .call = caller_env()
) {
  .External2(
    ffi_ptype_common_params,
    list2(...),
    .ptype,
    .finalise,
    .fallback_opts
  )
}

vec_ptype_common_fallback <- function(
  ...,
  .ptype = NULL,
  .arg = "",
  .call = caller_env()
) {
  vec_ptype_common_params(
    ...,
    .ptype = .ptype,
    .fallback_opts = enabled_fallback_opts(),
    .arg = .arg,
    .call = .call
  )
}

#' @export
#' @rdname vec_ptype
vec_ptype_show <- function(...) {
  args <- compact(list2(...))
  n <- length(args)
  if (n == 0) {
    cat_line("Prototype: NULL")
  } else if (n == 1) {
    cat_line("Prototype: ", vec_ptype_full(args[[1]]))
  } else {
    in_types <- map(args, vec_ptype)
    out_types <- vector("list", length(in_types))
    out_types[[1]] <- in_types[[1]]
    for (i in seq2(2, n)) {
      out_types[[i]] <- vec_ptype2(out_types[[i - 1]], in_types[[i]])
    }

    in_full <- paste0("<", map_chr(in_types, vec_ptype_full), ">")
    out_full <- paste0("<", map_chr(out_types, vec_ptype_full), ">")

    out <- cbind(
      n = paste0(seq(0, n - 1), ". "),
      lhs = c("", out_full[-n]),
      comma = " , ",
      rhs = in_full,
      equals = " = ",
      res = c(in_full[[1]], out_full[-1])
    )
    out <- t(apply(out, 1, pad_height))
    out <- apply(out, 2, pad_width)

    out[, "lhs"] <- parens(out[, "lhs"])
    out[, "rhs"] <- parens(out[, "rhs"], FALSE)

    lines <- strsplit(out, "\n")
    dim(lines) <- dim(out)

    steps <- apply(lines, 1, function(x) do.call(cbind, x))
    if (is.list(steps)) {
      step_lines <- unlist(lapply(steps, function(x) {
        apply(x, 1, paste0, collapse = "")
      }))
    } else {
      step_lines <- apply(steps, 2, paste0, collapse = "")
    }

    cat_line("Prototype: ", out_full[[n]])
    cat_line(step_lines)
  }

  invisible()
}

vec_typeof <- function(x) {
  .Call(vctrs_typeof, x, TRUE)
}
vec_typeof_bare <- function(x) {
  .Call(vctrs_typeof, x, FALSE)
}

vec_type_info <- function(x) {
  .Call(ffi_type_info, x)
}
vec_proxy_info <- function(x) {
  .Call(ffi_proxy_info, x)
}
