R/list.R

In dirkschumacher/llr: A lisp like language on top of R

#' @export
#' @import vctrs
ral_list <- function(..., .data = NULL, .subclass = NULL, .meta = NULL) {
  val <- if (is.null(.data)) {
    list(...)
  } else {
    stopifnot(is.list(`.data`))
    `.data`
  }
  class(val) <- c(.subclass, "ral_list")
  ral_meta_data <- if (!is.null(.meta) && inherits(.meta, "ral_map")) {
    .meta
  }
  new_vctr(val, ral_meta_data = ral_meta_data, class = class(val), inherit_base_type = TRUE)
}

#' @export
set_meta_data <- function(x, val, envir = NULL) {
  UseMethod("set_meta_data")
}

#' @export
meta_data <- function(x) {
  UseMethod("meta_data")
}

#' @export
set_meta_data.ral_list <- function(x, val, envir = NULL) {
  attr(x, "ral_meta_data") <- val
  x
}

#' @export
meta_data.ral_list <- function(x) {
  attr(x, "ral_meta_data", exact = TRUE)
}

#' @export
#' @include format.R
format.ral_list <- function(x, ...) {
  paste0(
    "(",
    paste0(vapply(x, function(x) llr_format(x), character(1)), collapse = " "),
    ")"
  )
}

#' @export
#' @include format.R
print.ral_list <- default_print

#' @export
vec_cast.character.ral_list <- function(x, to, ...) {
  format(x)
}

#' @export
vec_cast.list.ral_list <- function(x, to, ...) {
  ral_list(.data = c(x, vec_data(to)))
}

#' @export
vec_cast.ral_list.list <- function(x, to, ...) {
  ral_list(.data = c(vec_data(x), to))
}

#' @export
vec_ptype2.list.ral_list <- function(x, y, ...) {
  ral_list()
}

#' @export
vec_ptype2.ral_list.list <- function(x, y, ...) {
  ral_list()
}