Nothing
#' Enveomics: Cliopts
#'
#' Generates nicely formatted command-line interfaces for functions
#' (\strong{closures} only).
#'
#' @param fx Function for which the interface should be generated.
#' @param rd_file (Optional) .Rd file with the standard documentation of
#' the function.
#' @param positional_arguments (Optional) Number of \strong{positional}
#' arguments passed to \code{\link[optparse]{parse_args}}
#' (package: \pkg{optparse}).
#' @param usage (Optional) Usage passed to \code{\link[optparse]{OptionParser}}
#' (package: \pkg{optparse}).
#' @param mandatory Mandatory arguments.
#' @param vectorize Arguments of the function to vectorize (comma-delimited).
#' If numeric, use also \code{number}.
#' @param ignore Arguments of the function to ignore.
#' @param number Force these arguments as numerics. Useful for numeric
#' vectors (see \code{vectorize}) or arguments with no defaults.
#' @param defaults Defaults to use instead of the ones provided by the
#' formals.
#' @param o_desc Descriptions of the options. Help from \code{rd} is ignored
#' for arguments present in this list.
#' @param p_desc Description Description of the function. Help from \code{rd}
#' is ignored for the function description unless this value is an empty string.
#'
#' @return Returns a list with keys:
#' \itemize{
#' \item{\code{options}, a named list with the values for the function's
#' arguments}
#' \item{\code{args}, a vector with zero or more strings containing the
#' positional arguments}}
#'
#' @author Luis M. Rodriguez-R [aut, cre]
#'
#' @export
enve.cliopts <- function(
fx,
rd_file,
positional_arguments,
usage,
mandatory = c(),
vectorize = c(),
ignore = c(),
number = c(),
defaults = list(),
o_desc = list(),
p_desc = ""
){
# Load stuff
if (!suppressPackageStartupMessages(
requireNamespace("optparse", quietly = TRUE)))
stop("Package 'optparse' is required.")
requireNamespace("tools", quietly = TRUE)
if (missing(positional_arguments)) positional_arguments <- FALSE
if (missing(usage)) usage <- "usage: %prog [options]"
# Get help (if any)
if (!missing(rd_file)) {
rd <- tools::parse_Rd(rd_file)
for (i in 1:length(rd)) {
tag <- attr(rd[[i]], "Rd_tag")
if (tag == "\\description" && p_desc == "") {
p_desc <- paste("\n\t", as.character(rd[[i]]), sep = "")
} else if (tag == "\\arguments") {
for (j in 1:length(rd[[i]])) {
if (length(rd[[i]][[j]]) == 2) {
name <- as.character(rd[[i]][[j]][[1]])
if (length(o_desc[[name]]) == 1) next
desc <- as.character(rd[[i]][[j]][[2]])
o_desc[[name]] <- paste(gsub("\n", "\n\t\t", desc), collapse = "")
}
}
}
}
}
# Set options
o_i <- 0
opts <- list()
f <- formals(fx)
if (length(defaults) > 0) {
for (i in 1:length(defaults)) f[[names(defaults)[i]]] <- defaults[[i]]
}
for (i in names(f)) {
if (i == "..." || i %in% ignore) next
o_i <- o_i + 1
flag <- gsub("\\.", "-", i)
optopt <- list(help = "")
if (length(o_desc[[i]]) == 1) optopt$help <- o_desc[[i]]
if (!is.null(f[[i]])[1] && !suppressWarnings(is.na(f[[i]]))[1] &&
is.logical(f[[i]])[1]){
optopt$opt_str <- paste(ifelse(f[[i]], "--no-", "--"), flag, sep = "")
optopt$action <- ifelse(f[[i]], "store_false", "store_true")
} else {
optopt$opt_str <- paste("--", flag, sep = "")
optopt$action <- "store"
optopt$help <- paste(
optopt$help, "\n\t\t[",
ifelse(i %in% mandatory, "** MANDATORY", "default %default"),
ifelse(i %in% vectorize, ", separate values by commas", ""),
"].",
sep = ""
)
}
if (!is.name(f[[i]])) {
optopt$default <- f[[i]]
optopt$metavar <- class(f[[i]])
}
if (i %in% number) optopt$metavar <- "NUMERIC"
optopt$dest <- i
opts[[o_i]] <- do.call(optparse::make_option, optopt)
}
opt <- optparse::parse_args(
optparse::OptionParser(
option_list = opts, description = p_desc, usage = usage
),
positional_arguments = positional_arguments
)
# Post-hoc checks
if (length(opt[["options"]]) == 0) opt <- list(options = opt, args = c())
for (i in mandatory) {
if(length(opt$options[[i]]) == 0) stop("Missing mandatory argument: ", i)
}
for (i in vectorize) {
if (length(opt$options[[i]]) == 1)
opt$options[[i]] <- strsplit(opt$options[[i]], ",")[[1]]
}
for (i in number) {
if (length(opt$options[[i]]) > 0)
opt$options[[i]] <- as.numeric(opt$options[[i]])
}
opt$options$help <- NULL
return(opt)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.