alternative R function argument matching

pun.R

#' Get the name of a symbol or function call
#'
#' @param expr An expression to extract the name from.
#' @return A character string representing the name of the symbol or function call, or NULL if unsupported.
#' @examples
#' get_pun_name(quote(x)) # returns "x"
#' get_pun_name(quote(f(x))) # returns "f"
get_pun_name <- function(expr) {
  if (is.symbol(expr)) {
    return(as.character(expr))
  } else if (is.call(expr)) {
    return(as.character(expr[[1]]))
  } else {
    return(NULL)
  }
}

#' Create a function whose arguments are ordered like haskell's field puns, or
#' julia's f(; a,b) syntax
#'
#' @param f A function to be wrapped.
#' @param warn If TRUE, issue a warning if argNames is not one of the formals of f.
#' @return A new function that uses named field puns.
#' @examples
#' f <- function(A = 3, B = 1) {
#'   cat("A =", A, ", B =", B, "\n")
#' }
#' f_pun <- pun(f)
#' A <- function(x) {
#'   return(x)
#' }
#' B <- function(x) {
#'   return(x)
#' }
#' f_pun(B(3), A(4)) # should evaluate to "A=4, B=3"
#' f_pun(B(3), 4) # should evaluate to "A=4, B=3"
pun <- function(f, warn = FALSE) {
  return(function(...) {
    # Capture the expression
    args <- rlang::enquos(...)

    # Extract argument names
    argNames <- sapply(expr, get_pun_name)

    # Check if argNames are in the formals of f
    formals_f <- names(formals(f))
    if (warn && any(!argNames %in% formals_f)) {
      warning("Some argument names are not in the formals of the function")
    }

    # Separate named and positional arguments
    named_args <- args["" != names(args)]
    positional_args <- args["" == names(args)]

    positional_names <- formals_f[!(formals_f %in% names(named_args))]
    positional_names1 <- head(positional_names, length(positional_args))

    # Ensure named arguments are placed at the front
    named_args <- named_args[names(named_args) %in% formals_f]

    def_names <- formals_f[!(formals_f %in% names(named_args) | formals_f %in% positional_names1)]

    # Create a new call with named and positional arguments
    new_call <- rlang::call2(
      f, !!!named_args, !!!rlang::set_names(positional_args, positional_names1),
      setNames(rep(0, length(def_names)), def_names)
    )

    # Evaluate the new call
    rlang::eval_tidy(new_call)
  })
}