R/utils-rd.R

Defines functions fmt_formals make_function_usage collect_usage r6_usage

r6_usage <- function(
  x,
  name = "x"
){
  els <- collect_usage(x)

  c(
    "@section Usage:",
    "```", "",
    strwrap(paste0(name, " <- ", els$ctor), width = 80, exdent = 2), "",
    paste0(name, "$",  els$methods), "",
    paste0(name, "$", els$fields), "",
    "```"
  )
}




collect_usage <- function(
  x,
  name = "x"
){
  public_methods <- vapply(
    names(x$public_methods),
    function(nm) make_function_usage(nm, formals(x$public_methods[[nm]])),
    character(1)
  )


  if ("initialize" %in% names(public_methods)){
    ctor <- public_methods[["initialize"]]
    ctor <- gsub("^initialize", paste0(deparse(substitute(x)), "$new"), ctor)
  } else {
    ctor <- NULL
  }


  fields <- c(names(x$public_fields), names(x$active))
  if (!is.null(fields)) fields <- sort(fields)

  els <- list(
    ctor = ctor,
    methods =
      public_methods[!names(public_methods) %in% c("initialize", "finalize")],
    fields = fields
  )

  els <- els[!vapply(els, is_empty, FALSE)]

  if ("get_inherit" %in% names(x)){
    els <- c(els, collect_usage(x$get_inherit()))
    list(
      ctors   = els$ctor,  # the first one
      fields  = unique(unlist(els[names(els) == "fields"])),
      methods = unique(unlist(els[names(els) == "methods"]))
    )
  } else {
    els
  }
}




make_function_usage <- function(name, arglist){
  paste0(name, "(", fmt_formals(arglist), ")")
}




fmt_formals <- function(fmls){

  arg_to_text <- function(.x) {
    if (is.symbol(.x) && deparse(.x) == "")
      return("")

    text <- enc2utf8(deparse(.x, backtick = TRUE, width.cutoff = 500L))
    text <- paste0(text, collapse = "\n")
    Encoding(text) <- "UTF-8"
    text
  }

  res <- vapply(fmls, arg_to_text, character(1))
  sep <- ifelse(res == "", "", "\u{A0}=\u{A0}")
  paste0(names(res), sep, res, collapse = ", ")
}
s-fleck/shed documentation built on April 23, 2020, 12:51 p.m.