R/parseArgs.R

In acidgenomics/r-koopa: Shell Bootloader for Bioinformatics

#' Parse command line argument flags
#'
#' @export
#' @note Updated 2023-10-27.
#'
#' @param required,optional `character`.
#' Valid key-value pair argument names.
#' For example, `aaa` for `--aaa=AAA` or `--aaa AAA`.
#' Note that `--aaa AAA`-style arguments (note lack of `=`) are not currently
#' supported.
#'
#' @param flags `character`.
#' Valid long flag names.
#' For example, `aaa` for `--aaa`.
#' Short flags, such as `-r`, are intentionally not supported.
#'
#' @param positional `logical(1)`.
#' Require positional arguments to be defined.
#'
#' @return `list`.
#' Named list containing arguments, organized by type:
#' - `required`
#' - `optional`
#' - `flags`
#' - `positional`
#'
#' @seealso
#' - argparse Python package.
#' - argparser R package.
#' - optparse R package.
#'
#' @examples
#' ## Inside Rscript:
#' ## > args <- parseArgs(
#' ## >     required = c("aaa", "bbb"),
#' ## >     optional = c("ccc", "ddd"),
#' ## >     flags = "force",
#' ## >     positional = TRUE
#' ## > )
#' ## > aaa <- args[["required"]][["aaa"]]
#' ## > force <- "force" %in% args[["flags"]]
#' ## > posArgs <- args[["positional"]]
parseArgs <-
    function(required = character(),
             optional = character(),
             flags = character(),
             positional = FALSE) {
        assert(
            areDisjointSets(required, optional),
            areDisjointSets(required, flags),
            areDisjointSets(optional, flags),
            isFlag(positional)
        )
        cmdArgs <- commandArgs(trailingOnly = TRUE)
        ## Ensure we strip out quoting from shell handoff.
        cmdArgs <- gsub(
            pattern = "^['\"](.+)['\"]$",
            replacement = "\\1",
            x = cmdArgs
        )
        assert(hasNoDuplicates(cmdArgs))
        out <- list(
            required = character(),
            optional = character(),
            flags = character(),
            positional = character()
        )
        if (hasLength(flags)) {
            flagPattern <- "^--([^=[:space:]]+)$"
            flagArgs <- grep(pattern = flagPattern, x = cmdArgs, value = TRUE)
            cmdArgs <- setdiff(cmdArgs, flagArgs)
            flagNames <- sub(
                pattern = flagPattern,
                replacement = "\\1",
                x = flagArgs
            )
            ok <- flagNames %in% flags
            if (!all(ok)) {
                fail <- flagNames[!ok]
                abort(sprintf(
                    "Invalid flags detected: %s.",
                    toInlineString(fail, n = 5L)
                ))
            }
            out[["flags"]] <- flagNames
        }
        if (hasLength(required) || hasLength(optional)) {
            argPattern <- "^--([^=]+)=(.+)$"
            args <- grep(pattern = argPattern, x = cmdArgs, value = TRUE)
            cmdArgs <- setdiff(cmdArgs, args)
            names(args) <- sub(
                pattern = argPattern,
                replacement = "\\1",
                x = args
            )
            args <- sub(pattern = argPattern, replacement = "\\2", x = args)
            args <- sub(
                pattern = "^[\"']",
                replacement = "",
                x = args
            )
            args <- sub(
                pattern = "[\"']$",
                replacement = "",
                x = args
            )
            if (hasLength(required)) {
                ok <- required %in% names(args)
                if (!all(ok)) {
                    fail <- required[!ok]
                    abort(sprintf(
                        "Missing required args: %s.",
                        toInlineString(fail, n = 5L)
                    ))
                }
                out[["required"]] <- args[required]
                args <- args[!names(args) %in% required]
            }
            if (hasLength(optional) && hasLength(args)) {
                match <- match(x = names(args), table = optional)
                if (anyNA(match)) {
                    fail <- names(args)[is.na(match)]
                    abort(sprintf(
                        "Invalid args detected: %s.",
                        toInlineString(fail, n = 5L)
                    ))
                }
                out[["optional"]] <- args
            }
        }
        if (isTRUE(positional)) {
            if (
                !hasLength(cmdArgs) ||
                    any(grepl(pattern = "^--", x = cmdArgs))
            ) {
                abort("Positional arguments are required but missing.")
            }
            out[["positional"]] <- cmdArgs
        } else {
            if (hasLength(cmdArgs)) {
                abort(sprintf(
                    "Positional arguments are defined but not allowed: %s.",
                    toInlineString(cmdArgs, n = 5L)
                ))
            }
        }
        out
    }



#' @rdname parseArgs
#' @export
positionalArgs <- function() {
    x <- parseArgs(
        required = character(),
        optional = character(),
        flags = character(),
        positional = TRUE
    )
    x[["positional"]]
}



#' @rdname parseArgs
#' @export
hasPositionalArgs <- function() {
    hasLength(commandArgs(trailingOnly = TRUE))
}