R/secret-vec.R

In shunsambongi/himitsu: Read and Write Secrets

new_secret <- function(x = character()) {
  vec_assert(x, character())
  new_vctr(x, class = "himitsu_secret")
}

#' @export
secret <- function(x) {
  x <- vec_cast(x, character())
  new_secret(x)
}

#' @export
vec_ptype_full.himitsu_secret <- function(x) {
  "secret"
}

#' @export
vec_ptype_abbr.himitsu_secret <- function(x) {
  "scrt"
}

#' @export
format.himitsu_secret <- function(x, ...) {
  rep("*******", vec_size(x))
}

#' @method vec_ptype2 himitsu_secret
#' @export
#' @export vec_ptype2.himitsu_secret
#' @rdname himitsu-vctrs
vec_ptype2.himitsu_secret <- function(x, y, ...) {
  UseMethod("vec_ptype2.himitsu_secret", y)
}

#' @method vec_ptype2.himitsu_secret default
#' @export
vec_ptype2.himitsu_secret.default <- function(x, y, ..., x_arg = "x", y_arg = "y") {
  vec_default_ptype2(x, y, ..., x_arg = x_arg, y_arg = y_arg)
}

#' @method vec_ptype2.himitsu_secret himitsu_secret
#' @export
vec_ptype2.himitsu_secret.himitsu_secret <- function(x, y, ...) {
  new_secret()
}

#' @method vec_ptype2.himitsu_secret character
#' @export
vec_ptype2.himitsu_secret.character <- function(x, y, ...) {
  new_secret()
}

#' @method vec_ptype2.character himitsu_secret
#' @export
vec_ptype2.character.himitsu_secret <- function(x, y, ...) {
  new_secret()
}

#' @method vec_cast.character himitsu_secret
#' @export
vec_cast.character.himitsu_secret <- function(x, to, ..., x_arg = "x", to_arg = "to") {
  if (can_disclose()) disclose(x) else format(x)
}