R/make_methods.R

Defines functions make_methods make_setter_method_str make_getter_method_str

Documented in make_getter_method_str make_methods make_setter_method_str

#' Make method string
#'
#' @param field Character name of class field
#' @param is_public Logical, whether the field is in public list
#' @param add_roxygen Logical, whether to add roxygen description of method
#'
#' @return Character containing method definition
#'
#' @importFrom glue glue
#'
#' @name make_method_str
NULL

#' @rdname make_method_str
make_getter_method_str <- function(field, is_public = TRUE, add_roxygen = TRUE) {
  if (is.null(field)) return(NULL)

  if (is_public) {
    method_str <- glue("get_{field} = function() {{
      self${field}
    }}")
  } else {
    method_str <- glue("get_{field} = function() {{
      private${field}
    }}")
  }

  if (add_roxygen) {
    return(glue("#' @description Getter for {field}\n{method_str}"))
  }

  method_str
}

#' @rdname make_method_str
make_setter_method_str <- function(field, is_public = TRUE, add_roxygen = TRUE) {
  if (is.null(field)) return(NULL)

  if (is_public) {
    method_str <- glue("set_{field} = function({field}) {{
      self${field} <- {field}
    }}")
  } else {
    method_str <- glue("set_{field} = function({field}) {{
      private${field} <- {field}
    }}")
  }

  if (add_roxygen) {
    return(glue("#' @description Setter for {field}\n{method_str}"))
  }

  method_str
}

#' Make methods
#'
#' @param r6 R6 class for which to create methods
#' @param field Character, fields for which to create method. May be "all",
#'   "public", "private" or name of class field. Multiple values allowed.
#' @param method Character, methods to create. One of "both", "get", "set"
#' @param add_roxygen Logical, whether to add roxygen description of method
#'
#' @return Character containing generated methods to put into class definition
#' @export
#'
#' @importFrom glue glue_collapse
#' @importFrom purrr map imap
#'
#' @examples
#' Example <- R6::R6Class("Example", list(public_field = NULL), list(private_field = NULL))
#' make_methods(Example)
#' make_methods(Example, "private", "get")
#' make_methods(Example, "private_field", c("get", "set"))
#' make_methods(Example, "public_field", c("both"))
make_methods <- function(
  r6,
  field = c("all", "public", "private", names(r6$public_fields), names(r6$private_fields)),
  method = c("both", "get", "set"),
  add_roxygen = TRUE
) {

  match.arg(field, several.ok = TRUE)
  match.arg(method, several.ok = TRUE)

  # method <- method[1]

  public_methods <- names(r6$public_methods)
  public_fields <- names(r6$public_fields)
  private_fields <- names(r6$private_fields)

  if (length(c(public_fields, private_fields)) == 0) {
    stop("Supplied R6 class has no fields")
  }

  fields <- list(
    "all" = c(public_fields, private_fields),
    "public" = public_fields,
    "private" = private_fields
  )

  methods <- list(
    "set" = make_setter_method_str,
    "get" = make_getter_method_str
  )

  if ("both" %in% method) method <- c("set", "get")

  # Get names of fields and make sure they aren't repeated
  fields <- fields[field]
  fields <- fields[!is.null(fields)]
  fields <- unique(unlist(fields, use.names = FALSE))
  fields <- c(fields, field[!field %in% fields & !field %in% c("all", "public", "private")])

  methods_str <- map(fields, function(f) {
    imap(methods[method], function(m, n) {
      if (glue("{n}_{f}") %in% public_methods) return(NULL)
      m(f, f %in% public_fields, add_roxygen)
    })
  })

  glue_collapse(unlist(methods_str), sep = ",\n")
}

Try the r6methods package in your browser

Any scripts or data that you put into this service are public.

r6methods documentation built on March 16, 2021, 9:06 a.m.