R/to_chr.R

In stbl: Stabilize Function Arguments

#' @export
#' @rdname stabilize_chr
to_chr <- function(x,
                   allow_null = TRUE,
                   x_arg = caller_arg(x),
                   call = caller_env(),
                   x_class = object_type(x)) {
  UseMethod("to_chr")
}

#' @export
to_chr.character <- function(x, ...) {
  return(x)
}

#' @export
to_chr.NULL <- function(x,
                        ...,
                        allow_null = TRUE,
                        x_arg = caller_arg(x),
                        call = caller_env()) {
  to_null(x, allow_null = allow_null, x_arg = x_arg, call = call)
}

#' @export
to_chr.list <- function(x,
                        ...,
                        x_arg = caller_arg(x),
                        call = caller_env(),
                        x_class = object_type(x)) {
  flat <- unlist(x)
  if (length(flat) == length(x)) {
    if (length(flat) == 1) {
      flat <- flat[[1]]
    }
    return(to_chr(flat))
  }
  .stop_cant_coerce(
    from_class = x_class,
    to_class = "character",
    x_arg = x_arg,
    call = call
  )
}

#' @export
to_chr.data.frame <- function(x,
                              ...,
                              x_arg = caller_arg(x),
                              call = caller_env(),
                              x_class = object_type(x)) {
  .stop_cant_coerce(
    from_class = x_class,
    to_class = "character",
    x_arg = x_arg,
    call = call
  )
}

#' @export
to_chr.default <- function(x,
                           ...,
                           x_arg = caller_arg(x),
                           call = caller_env(),
                           x_class = object_type(x)) {
  try_fetch(
    as.character(x),
    error = function(cnd) {
      .stop_cant_coerce(
        from_class = x_class,
        to_class = "character",
        x_arg = x_arg,
        call = call
      )
    }
  )
}