cmdfun/0000755000176200001440000000000013740277433011540 5ustar liggesuserscmdfun/NAMESPACE0000644000176200001440000000127613735624327012767 0ustar liggesusers# Generated by roxygen2: do not edit by hand export(.check_valid_command_path) export(.check_valid_util) export(cmd_args_all) export(cmd_args_dots) export(cmd_args_named) export(cmd_error_if_missing) export(cmd_file_combn) export(cmd_file_expect) export(cmd_help_flags_similar) export(cmd_help_flags_suggest) export(cmd_help_parse_flags) export(cmd_install_check) export(cmd_install_is_valid) export(cmd_list_drop) export(cmd_list_drop_named) export(cmd_list_interp) export(cmd_list_keep) export(cmd_list_keep_named) export(cmd_list_to_flags) export(cmd_path_search) export(cmd_ui_file_exists) importFrom(magrittr,"%<>%") importFrom(magrittr,"%>%") importFrom(magrittr,"%T>%") importFrom(utils,adist) cmdfun/LICENSE0000644000176200001440000000006013717602450012534 0ustar liggesusersYEAR: 2020 COPYRIGHT HOLDER: Spencer L. Nystrom cmdfun/README.md0000644000176200001440000002000013721610674013004 0ustar liggesuserscmdfun ================ [![Lifecycle: maturing](https://img.shields.io/badge/lifecycle-maturing-blue.svg)](https://www.tidyverse.org/lifecycle/#maturing) [![Project Status: Active – The project has reached a stable, usable state and is being actively developed.](https://www.repostatus.org/badges/latest/active.svg)](https://www.repostatus.org/#active) [![R build status](https://github.com/snystrom/cmdfun/workflows/R-CMD-check/badge.svg)](https://github.com/snystrom/cmdfun/actions) [![Codecov test coverage](https://codecov.io/gh/snystrom/cmdfun/branch/master/graph/badge.svg)](https://codecov.io/gh/snystrom/cmdfun?branch=master) ## A simple framework for building shell interfaces The purpose of `cmdfun` is to significantly reduce the overhead involved in wrapping shell programs in R. The tools are intended to be intuitive and lightweight enough to use for data scientists trying to get things done quickly, but robust and full-fledged enough for developers to extend them to more advanced use cases. ## Installation Install the development version of `cmdfun` with: ``` r if (!requireNamespace("remotes")) install.packages("remotes") remotes::install_github("snystrom/cmdfun") ``` ## Quick Overview The `cmdfun` framework provides mechanisms for capturing function arguments: - `cmd_args_dots()` captures all arguments passed to `...` - `cmd_args_named()` captures all keyword arguments defined by the user - `cmd_args_all()` captures both named + dot arguments ``` r library(cmdfun) myFunction <- function(input, ...){ cmd_args_all() } (argsList <- myFunction(input = "test", boolean_flag = TRUE)) ``` ## $input ## [1] "test" ## ## $boolean_flag ## [1] TRUE `cmd_list_interp` converts the captured argument list to a parsed list of flag/value pairs. ``` r (flagsList <- cmd_list_interp(argsList)) ``` ## $input ## [1] "test" ## ## $boolean_flag ## [1] "" `cmd_list_to_flags` converts a list to a vector of commandline-style flags using the list names as flag names and the list values as the flag values (empty values return only the flag). This output can be directly fed to `system2` or `processx`. ``` r cmd_list_to_flags(flagsList) ``` ## [1] "-input" "test" "-boolean_flag" `cmd_path_search()` allows package builders to search default locations for installed tools. ``` r bin_path <- cmd_path_search(default_path = "/bin", utils = c("ls", "cut")) bin_path(util = "ls") ``` ## [1] "//bin/ls" ## Introduction `cmdfun` attempts to solve the problem of wrapping external software in R. Calling external software is done with `system2` or `processx`. For example, calling `ls -l *.md` using `system2`. ``` r system2("ls", "-l *.md", stdout = TRUE) ``` ## [1] "-rw-r--r-- 1 snystrom its_employee_psx 1077 Aug 20 19:20 LICENSE.md" ## [2] "-rw-r--r-- 1 snystrom its_employee_psx 837 Aug 26 21:51 NEWS.md" ## [3] "-rw-r--r-- 1 snystrom its_employee_psx 7718 Aug 26 20:14 README.md" ## [4] "-rw-r--r-- 1 snystrom its_employee_psx 744 Aug 26 21:35 cran-comments.md" However, when using multiple commandline flags each flag should be passed as a member of a character vector as follows: When calling `ls -l -i` ``` r system2("ls", c("-l", "-i", "*.md"), stdout = TRUE) ``` ## [1] "1163031755 -rw-r--r-- 1 snystrom its_employee_psx 1077 Aug 20 19:20 LICENSE.md" ## [2] "1163031757 -rw-r--r-- 1 snystrom its_employee_psx 837 Aug 26 21:51 NEWS.md" ## [3] "1163031758 -rw-r--r-- 1 snystrom its_employee_psx 7718 Aug 26 20:14 README.md" ## [4] "1163031762 -rw-r--r-- 1 snystrom its_employee_psx 744 Aug 26 21:35 cran-comments.md" This becomes even more difficult if trying to support user input, as a significant amount of overhead is required to parse user inputs and optional flags into these vectors. `cmdfun` provides utilities for converting **function arguments** into **lists** which can easily convert to **character vectors** suitable for use with `system2` or `processx`. ``` r library(cmdfun) myFunction <- function(input, option1){ # Grabs named arguments as key/value pairs cmd_args_named() } (argsList <- myFunction("myInput.txt", "foo")) ``` ## $input ## [1] "myInput.txt" ## ## $option1 ## [1] "foo" ``` r # Converts list to character vector of flags & values cmd_list_to_flags(argsList) ``` ## [1] "-input" "myInput.txt" "-option1" "foo" ### Wrapping `ls` with cmdfun These tools can be used to easily wrap `ls` ``` r library(magrittr) shell_ls <- function(dir = ".", ...){ # grab arguments passed to "..." in a list flags <- cmd_args_dots() %>% # prepare list for conversion to vector cmd_list_interp() %>% # Convert the list to a flag vector cmd_list_to_flags() # Run ls shell command system2("ls", c(flags, dir), stdout = TRUE) } ``` ``` r shell_ls("*.md") ``` ## [1] "LICENSE.md" "NEWS.md" "README.md" "cran-comments.md" #### Boolean flags are passed as bool operators `ls -l` can be mimicked by passing `l = TRUE` to ‘…’. ``` r shell_ls("*.md", l = TRUE) ``` ## [1] "-rw-r--r-- 1 snystrom its_employee_psx 1077 Aug 20 19:20 LICENSE.md" ## [2] "-rw-r--r-- 1 snystrom its_employee_psx 837 Aug 26 21:51 NEWS.md" ## [3] "-rw-r--r-- 1 snystrom its_employee_psx 7718 Aug 26 20:14 README.md" ## [4] "-rw-r--r-- 1 snystrom its_employee_psx 744 Aug 26 21:35 cran-comments.md" ### Named vectors can be used to provide user-friendly aliases for single-letter flags Commandline tools can have hundreds of arguments, many with uninformative, often single-letter, names. To prevent developers from having to write aliased function arguments for all, often conflicting flags, `cmd_list_interp` can additionally use a lookup table to allow developers to provide informative function argument names for unintuitive flags. For example, allowing `long` to act as `-l` in `ls`. ``` r shell_ls_alias <- function(dir = ".", ...){ # Named vector acts as lookup table # name = function argument # value = flag name names_arg_to_flag <- c("long" = "l") flags <- cmd_args_dots() %>% # Use lookup table to manage renames cmd_list_interp(names_arg_to_flag) %>% cmd_list_to_flags() system2("ls", c(flags, dir), stdout = TRUE) } ``` ``` r shell_ls_alias("*.md", long = TRUE) ``` ## [1] "-rw-r--r-- 1 snystrom its_employee_psx 1077 Aug 20 19:20 LICENSE.md" ## [2] "-rw-r--r-- 1 snystrom its_employee_psx 837 Aug 26 21:51 NEWS.md" ## [3] "-rw-r--r-- 1 snystrom its_employee_psx 7718 Aug 26 20:14 README.md" ## [4] "-rw-r--r-- 1 snystrom its_employee_psx 744 Aug 26 21:35 cran-comments.md" ### Wrapping `cut` with cmdfun Here is another example wrapping `cut` which separates text on a delimiter (set with `-d`) and returns selected fields (set with `-f`) from the separation. ``` r shell_cut <- function(text, ...){ names_arg_to_flag <- c("sep" = "d", "fields" = "f") flags <- cmd_args_dots() %>% cmd_list_interp(names_arg_to_flag) %>% cmd_list_to_flags() system2("cut", flags, stdout = T, input = text) } ``` ``` r shell_cut("hello_world", fields = 2, sep = "_") ``` ## [1] "world" #### Multiple values are passed as vectors ``` r shell_cut("hello_world_hello", fields = c(1,3), sep = "_") ``` ## [1] "hello_hello" Additionally, `cmdfun` provides utilites for searching & checking valid tool installs, expecting system behavior, and helpful error handling to allow simple construction of external tool wrappers (see [vignette](https://snystrom.github.io/cmdfun/articles/cmdfun.html) for details). ## More Details See for the most recent documentation and to learn about all `cmdfun` features. To file bug reports, please visit while providing a [reproducible example](https://reprex.tidyverse.org/) of your issue. cmdfun/man/0000755000176200001440000000000013735622544012314 5ustar liggesuserscmdfun/man/dot-check_valid_util.Rd0000644000176200001440000000152513717555313016662 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/macros.R \name{.check_valid_util} \alias{.check_valid_util} \title{Checks for valid members of subdirectory} \usage{ .check_valid_util(util, utils = NULL, path = NULL) } \arguments{ \item{util}{name of target located in path} \item{utils}{name of supported targets in path} \item{path}{path to directory} } \value{ safe path to util, or error if util does not exist } \description{ Not meant to be called directly } \examples{ if (.Platform$OS.type == "unix") { # this will return /full/path/to/bin # or return an error for all values of util that are not "ls" and "pwd" # or error if "ls" does not exist in "/bin" .check_valid_util("ls", utils = c("ls", "pwd"), "/bin") \dontrun{ # This will throw error .check_valid_util("badUtil", utils = c("ls", "pwd"), "/bin") } } } cmdfun/man/cmd_ui_file_exists.Rd0000644000176200001440000000067713717555313016452 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/utils.R \name{cmd_ui_file_exists} \alias{cmd_ui_file_exists} \title{Checks if file exists, returns pretty status message} \usage{ cmd_ui_file_exists(file) } \arguments{ \item{file}{path to file} } \value{ ui_done or ui_oops printed to terminal. } \description{ Checks if file exists, returns pretty status message } \examples{ cmd_ui_file_exists("/path/to/file.txt") } cmdfun/man/cmd_args_all.Rd0000644000176200001440000000126513717555313015215 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cmd_args.R \name{cmd_args_all} \alias{cmd_args_all} \title{Return all named arguments and arguments passed as dots from parent function call} \usage{ cmd_args_all(keep = NULL, drop = NULL) } \arguments{ \item{keep}{name of arguments to keep} \item{drop}{name of arguments to drop (NOTE: keep or drop are mutually exclusive settings)} } \value{ named list of all arguments passed to parent } \description{ Return all named arguments and arguments passed as dots from parent function call } \examples{ theFunction <- function(arg1, ...) { cmd_args_all() } theArgs <- theFunction(arg1 = "test", example = "hello") } cmdfun/man/cmd_args_named.Rd0000644000176200001440000000122413717555313015524 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cmd_args.R \name{cmd_args_named} \alias{cmd_args_named} \title{Return all named arguments from parent function call} \usage{ cmd_args_named(keep = NULL, drop = NULL) } \arguments{ \item{keep}{name of arguments to keep} \item{drop}{name of arguments to drop (NOTE: keep or drop are mutually exclusive settings)} } \value{ named list of all defined function arguments from parent } \description{ Return all named arguments from parent function call } \examples{ theFunction <- function(arg1, ...) { cmd_args_named() } theNamedArgs <- theFunction(arg1 = "test", example = "hello") } cmdfun/man/cmd_args_dots.Rd0000644000176200001440000000121113717555313015405 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cmd_args.R \name{cmd_args_dots} \alias{cmd_args_dots} \title{return function dots from parent function as named list} \usage{ cmd_args_dots(keep = NULL, drop = NULL) } \arguments{ \item{keep}{name of arguments to keep} \item{drop}{name of arguments to drop (NOTE: keep or drop are mutually exclusive settings)} } \value{ named list of kwargs from ... } \description{ return function dots from parent function as named list } \examples{ theFunction <- function(...) { cmd_args_dots() } theDots <- theFunction(example = "hello", boolFlag = TRUE, vectorFlag = c(1,2,3)) } cmdfun/man/cmd_list_drop_named.Rd0000644000176200001440000000113713735623201016562 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/utils.R \name{cmd_list_drop_named} \alias{cmd_list_drop_named} \title{Drop items by name from list} \usage{ cmd_list_drop_named(list, names) } \arguments{ \item{list}{an R list} \item{names}{vector of names to drop} } \value{ list removing items defined by names } \description{ A pipe-friendly wrapper around \code{list[!(names(list) \%in\% names)]} This function is slightly faster than using \code{\link[=cmd_list_drop]{cmd_list_drop()}} to drop items by name. } \examples{ cmd_list_drop_named(list("a" = 1, "b" = 2), "a") } cmdfun/man/cmd_error_if_missing.Rd0000644000176200001440000000104513717604505016763 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/utils.R \name{cmd_error_if_missing} \alias{cmd_error_if_missing} \title{Check that file(s) exist, error if not} \usage{ cmd_error_if_missing(files) } \arguments{ \item{files}{list or vector of paths to check} } \value{ nothing or error message for each missing file } \description{ Check that file(s) exist, error if not } \examples{ cmd_error_if_missing(tempdir()) \dontrun{ # Throws error if file doesn't exist cmd_error_if_missing(file.path(tempdir(), "notreal")) } } cmdfun/man/cmd_install_check.Rd0000644000176200001440000000142113717747123016230 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/utils.R \name{cmd_install_check} \alias{cmd_install_check} \title{Wrapper function for checking an install} \usage{ cmd_install_check(path_search, path = NULL) } \arguments{ \item{path_search}{\code{function} output of \code{cmd_path_search()}} \item{path}{user-override path to check (identical to \code{path} argument of \code{cmd_path_search()} output)} } \value{ pretty printed message indicating whether files exits or not. Green check = Yes, red X = No. } \description{ This function can be lightly wrapped by package builders to build a user-friendly install checking function. } \examples{ \dontrun{ path_search <- cmd_path_search(default = "/bin", utils = "ls") cmd_install_check(path_search) } } cmdfun/man/cmd_help_flags_similar.Rd0000644000176200001440000000401013721610570017234 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parse_help.R \name{cmd_help_flags_similar} \alias{cmd_help_flags_similar} \title{Suggest alternative name by minimizing Levenshtein edit distance between valid and invalid arguments} \usage{ cmd_help_flags_similar( command_flag_names, flags, .fun = NULL, distance_cutoff = 3L ) } \arguments{ \item{command_flag_names}{character vector of valid names (can be output of \code{\link{cmd_help_parse_flags}})} \item{flags}{a vector names correspond to values to be checked against \code{command_flag_names}} \item{.fun}{optional function to apply to \code{command_flag_names} and \code{flags} before checking their values. If using a function to rename flags after \code{cmd_list_interp}, use that same function here. Can be useful for parsing help lines into R-friendly variable names for user-convenience. Can be function or \code{rlang}-style formula definition (ie \code{.fun = ~{foo(.x)}} is the same as \code{.fun = function(x){foo(x)}}). Note: if command_flag_names need additional parsing after \code{\link{cmd_help_parse_flags}}, it is best to do that preprocessing before passing them to this function.} \item{distance_cutoff}{Levenshtein edit distance beyond which to suggest ??? instead of most similar argument (default = 3). Setting this too liberally will result in nonsensical suggestions.} } \value{ named vector where names are names from \code{flags} and their values are the suggested best match from \code{command_flag_names} } \description{ Suggest alternative name by minimizing Levenshtein edit distance between valid and invalid arguments } \examples{ # with a flagsList, need to pass names() flagsList <- list("output" = "somevalue", "missplld" = "anotherValue") cmd_help_flags_similar(c("output", "misspelled"), names(flagsList)) command_flags <- c("long-flag-name") flags <- c("long_flag_naee") cmd_help_flags_similar(command_flags, flags, .fun = ~{gsub("-", "_", .x)}) # returns NULL if no errors cmd_help_flags_similar(c("test"), "test") } cmdfun/man/cmd_file_combn.Rd0000644000176200001440000000164313717604505015524 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/utils.R \name{cmd_file_combn} \alias{cmd_file_combn} \title{Generates list of expected output files} \usage{ cmd_file_combn(prefix, ext, outdir = ".") } \arguments{ \item{prefix}{file name to be given each ext. If a character vector, must be equal length of ext or shorter} \item{ext}{file extension (no ".", ie "txt", "html")} \item{outdir}{optional directory where files should exist} } \value{ list of file paths by each ext or prefix (whichever is longer) } \description{ See documentation of cmd_file_expect() for more details about how this works } \examples{ # Makes list for many file types of same prefix # ie myFile.txt, myFile.html, myFile.xml cmd_file_combn("myFile", c("txt", "html", "xml")) # Makes list for many files of same type # ie myFile1.txt, myFile2.txt, myFile3.txt cmd_file_combn(c("myFile1", "myFile2", "myFile3"), "txt") } cmdfun/man/cmd_list_interp.Rd0000644000176200001440000000164513717747123015771 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cmd_args.R \name{cmd_list_interp} \alias{cmd_list_interp} \title{Convert list of function arguments to list of command flags} \usage{ cmd_list_interp(args, flag_lookup = NULL) } \arguments{ \item{args}{named list output from get*Args family of functions.} \item{flag_lookup}{optional named vector used to convert args to command flags} } \value{ named list } \description{ Function also handles error checking to ensure args contain valid data types, and looks for common usage mistakes. } \details{ The list structure is more amenable to manipulation by package developers for advanced use before evaluating them to the command flags vector with cmd_list_to_flags(). } \examples{ theFunction <- function(...){cmd_args_all()} theArgs <- theFunction(arg1 = "value", arg2 = TRUE) flagList <- cmd_list_interp(theArgs) flags <- cmd_list_to_flags(flagList) } cmdfun/man/cmd_list_keep.Rd0000644000176200001440000000204613717747123015410 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/utils.R \name{cmd_list_keep} \alias{cmd_list_keep} \title{keep entries from list of flags by name, name/value pair, or index} \usage{ cmd_list_keep(flags, keep) } \arguments{ \item{flags}{named list output of cmd_list_interp} \item{keep}{vector of flag entries to keep. Pass a character vector to keep flags by name. Pass a named vector to keep flags by name/value pairs. Pass a numeric vector to keep by position.} } \value{ flags list with values not in keep removed } \description{ keep entries from list of flags by name, name/value pair, or index } \examples{ exFlags <- list("flag1" = 2, "flag2" = "someText") cmd_list_keep(exFlags, "flag1") # will keep flag2 because its name and value match 'keep' vector cmd_list_keep(exFlags, c("flag2" = "someText")) # Will keep "flag1" by position index cmd_list_keep(exFlags, 1) # won't keep flag2 because its value isn't 'someText' exFlags2 <- list("flag1" = 2, "flag2" = "otherText") cmd_list_keep(exFlags, c("flag2" = "someText")) } cmdfun/man/cmd_help_flags_suggest.Rd0000644000176200001440000000132013717555313017266 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parse_help.R \name{cmd_help_flags_suggest} \alias{cmd_help_flags_suggest} \title{Error & Suggest different flag name to user} \usage{ cmd_help_flags_suggest(suggest_names) } \arguments{ \item{suggest_names}{named character vector, names correspond to original value, values correspond to suggested replacement.} } \value{ error message suggesting alternatives to user } \description{ Error & Suggest different flag name to user } \examples{ user_flags <- list("output", "inpt") valid_flags <- c("output", "input") suggestions <- cmd_help_flags_similar(valid_flags, user_flags) \dontrun{ # Throws error cmd_help_flags_suggest(suggestions) } } cmdfun/man/cmd_list_drop.Rd0000644000176200001440000000204213717747123015424 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/utils.R \name{cmd_list_drop} \alias{cmd_list_drop} \title{Drop entries from list of flags by name, name/value pair, or index} \usage{ cmd_list_drop(flags, drop) } \arguments{ \item{flags}{named list output of cmd_list_interp} \item{drop}{vector of flag entries to drop. Pass a character vector to drop flags by name. Pass a named vector to drop flags by name/value pairs. Pass a numeric vector to drop by position.} } \value{ flags list with values in drop removed } \description{ Drop entries from list of flags by name, name/value pair, or index } \examples{ exFlags <- list("flag1" = 2, "flag2" = "someText") cmd_list_drop(exFlags, "flag1") # will drop flag2 because its name and value match 'drop' vector cmd_list_drop(exFlags, c("flag2" = "someText")) # Will drop "flag1" by position index cmd_list_drop(exFlags, 1) # won't drop flag2 because its value isn't 'someText' exFlags2 <- list("flag1" = 2, "flag2" = "otherText") cmd_list_drop(exFlags, c("flag2" = "someText")) } cmdfun/man/dot-check_valid_command_path.Rd0000644000176200001440000000102613717555313020333 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/macros.R \name{.check_valid_command_path} \alias{.check_valid_command_path} \title{Checks path is valid} \usage{ .check_valid_command_path(path) } \arguments{ \item{path}{path to file or directory} } \value{ expanded system path } \description{ Not meant to be called directly } \examples{ if (.Platform$OS.type == "unix" & file.exists("~/bin")) { # will return /full/path/to/home/bin, or error if path doesn't exist .check_valid_command_path("~/bin") } } cmdfun/man/cmd_list_keep_named.Rd0000644000176200001440000000115613735623201016543 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/utils.R \name{cmd_list_keep_named} \alias{cmd_list_keep_named} \title{Keep items by name from list} \usage{ cmd_list_keep_named(list, names) } \arguments{ \item{list}{an R list} \item{names}{vector of names to keep} } \value{ list keeping only items defined by names } \description{ A pipe-friendly wrapper around \verb{list[(names(list) \%in\% names]}. } \details{ This function is slightly faster than using \code{\link[=cmd_list_keep]{cmd_list_keep()}} to keep items by name. } \examples{ cmd_list_keep_named(list("a" = 1, "b" = 2), "a") } cmdfun/man/cmd_file_expect.Rd0000644000176200001440000000216113717604505015712 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/utils.R \name{cmd_file_expect} \alias{cmd_file_expect} \title{Creates list of paths by file extension & checks they exist} \usage{ cmd_file_expect(prefix, ext, outdir = ".") } \arguments{ \item{prefix}{name of file prefix for each extension.} \item{ext}{vector of file extensions} \item{outdir}{directory the files will be inside} } \value{ vector of valid file paths } \description{ Ext or prefix can be a vector or single character. The shorter value will be propagated across all values of the other. See Examples for details. } \details{ If files are not found, throws an error } \examples{ \dontrun{ # Expects many file types of same prefix # ie myFile.txt, myFile.html, myFile.xml cmd_file_expect("myFile", c("txt", "html", "xml")) # Expects many files of same type # ie myFile1.txt, myFile2.txt, myFile3.txt cmd_file_expect(c("myFile1", "myFile2", "myFile3"), "txt") # Expects many files with each prefix and each extension # ie myFile1.txt, myFile1.html, myFile2.txt, myFile2.html cmd_file_expect(c("myFile1", "myFile2"), c("txt", "html")) } } cmdfun/man/cmd_path_search.Rd0000644000176200001440000000526213721610570015703 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/macros.R \name{cmd_path_search} \alias{cmd_path_search} \title{Macro for constructing target path validators} \usage{ cmd_path_search( environment_var = NULL, option_name = NULL, default_path = NULL, utils = NULL ) } \arguments{ \item{environment_var}{name of R environment variable defining target path. Can be set in .Renviron.} \item{option_name}{name of user-configurable option (called by getOption) which will hold path to target} \item{default_path}{default install path of target. Can contain shell specials like "~" which will be expanded at runtime (as opposed to build time of the search function).} \item{utils}{optional character vector containing names of valid utils inside target path, used to populate error checking for valid install.} } \value{ function that returns a valid path to tool or optional utility. The returned path_search function takes as input a path or util. where path is a user override path for the supported tool. If the user-defined path is invalid, this will always throw an error and not search the defined defaults. util must be found within the target path, but does not have to be present in the original "utils" call. The user will be warned if this is the case. If \code{util} is set to \code{TRUE} will return all paths to utilities without checking the install. This can be used for writing user-facing install checkers. } \description{ A common pattern in designing shell interfaces is to ask the user to give an absolute path to the target shell utility. It is common to pass this information from the user to R by using either R environment variables defined in .Renviron, using options (set with option(), and got with getOption()), having the user explicitly pass the path in the function call, or failing this, using a default install path. } \details{ Another common use-case involves software packages with many tools packaged in a single directory, and the user may want to call one or many utilities within this common structure. For example, the software "coolpackage" is installed in "~/coolpackage", and has two programs: "tool1", and "tool2" found in "~/coolpackage/tool1" and ~/coolpackage/tool2", respectively. To design an interface to coolpackage, this function can automate checking and validation for not only the package, but for each desired utility in the package. The hierarchy of path usage is: user-defined > option_name > environment_var > default_path } \examples{ if (.Platform$OS.type == "unix") { bin_checker <- cmd_path_search(default_path = "/bin", utils = c("ls", "pwd")) # returns path to bin bin_checker() # returns path to bin/ls bin_checker(util = "ls") } } cmdfun/man/cmd_install_is_valid.Rd0000644000176200001440000000354113717747123016752 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/macros.R \name{cmd_install_is_valid} \alias{cmd_install_is_valid} \title{Macro for constructing boolean check for valid path} \usage{ cmd_install_is_valid(path_search, util = NULL) } \arguments{ \item{path_search}{function output of \code{cmd_path_search()} \strong{NOTE:} When passing the function, do not pass as: \code{fun()}, but \code{fun} to avoid evaluation.} \item{util}{value to pass to \code{util} argument of \code{path_search}, allows building individual functions for each util (if passing one of each), or for simultaneously checking all utils if setting \code{util = TRUE}. Will cause error if \code{util = TRUE} but no utils are defined. \strong{NOTE:} There is no error checking for whether \code{util} is set correctly during the build process, so ensure correct spelling, etc. to avoid cryptic failures.} } \value{ a function returning TRUE or FALSE if a valid install is detected. With arguments: \code{path} (a path to install location), \code{util} an optional \code{character(1)} to } \description{ Macro for constructing boolean check for valid path } \examples{ if (.Platform$OS.type == "unix") { search <- cmd_path_search(option_name = "bin_path", default_path = "/bin/") valid_install <- cmd_install_is_valid(search) # Returns TRUE if "/bin/" exists valid_install() # Returns FALSE if "bad/path/" doesn't exist valid_install("bad/path/") # Also works with options search_option_only <- cmd_path_search(option_name = "bin_path") valid_install2 <- cmd_install_is_valid(search_option_only) options(bin_path = "/bin/") valid_install2() # Setting util = TRUE will check that all utils are also installed search_with_utils <- cmd_path_search(default_path = "/bin", utils = c("ls", "pwd")) valid_install_all <- cmd_install_is_valid(search_with_utils, util = TRUE) valid_install_all() } } cmdfun/man/cmd_help_parse_flags.Rd0000644000176200001440000000430213721610570016712 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parse_help.R \name{cmd_help_parse_flags} \alias{cmd_help_parse_flags} \title{Parses commandline help options to return vector of valid flag names} \usage{ cmd_help_parse_flags(help_lines, split_newline = FALSE) } \arguments{ \item{help_lines}{\code{character} vector containing the output of "command --help", or similar output. Optional: pass either \code{stdout}, or \code{stderr} output from processx::run(), must set \code{processx = TRUE}.} \item{split_newline}{\code{logical(1)} if set to TRUE will split string on "\\n" before parsing (useful when parsing output from \code{processx}).} } \value{ character vector of flag names parsed from help text } \description{ When using cmdfun to write lazy shell wrappers, the user can easily mistype a commandline flag since there is not text completion. Some programs behave unexpectedly when flags are typed incorrectly, and for this reason return uninformative error messages. } \details{ \code{cmd_help_parse_flags} tries to grab flags from --help documentation which can be used for error checking. It will try to parse flags following "-" or "--" while ignoring hyphenated words in help text. Although this should cover most use-cases, it may be necessary to write a custom help-text parser for nonstandard tools. Inspect this output \strong{carefully} before proceeding. Most often, characters are leftover at the \strong{end} of parsed names, which will require additional parsing. } \examples{ if (.Platform$OS.type == "unix" & file.exists("/bin/tar")) { # below are two examples parsing the --help method of GNU tar # with processx if (require(processx)) { out <- processx::run("tar", "--help", error_on_status = FALSE) fn_flags <- cmd_help_parse_flags(out$stdout, split_newline = TRUE) } # with system2 lines <- system2("tar", "--help", stderr = TRUE) fn_flags <- cmd_help_parse_flags(lines) # NOTE: some of the "tar" flags contain the extra characters: "\\[", "\\)", and ";" # ie "one-top-level\[" which should be "one-top-level" # These can be additionally parsed using gsub("[\\\\[;\\\\)]", "", fn_flags) } } \seealso{ \code{\link{cmd_help_flags_similar}} \code{\link{cmd_help_flags_suggest}} } cmdfun/man/cmd_list_to_flags.Rd0000644000176200001440000000154213721610570016250 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cmd_args.R \name{cmd_list_to_flags} \alias{cmd_list_to_flags} \title{Convert flag list to vector of command flags} \usage{ cmd_list_to_flags(flagList, prefix = "-", sep = ",") } \arguments{ \item{flagList}{output from cmd_list_interp(). A named list where names correspond to flags and members correspond to the value for the flag.} \item{prefix}{flag prefix, usually "-" or "--".} \item{sep}{separator to use if flag has a vector of values (default: NULL).} } \value{ character vector of parsed commandline flags followed by their values } \description{ Convert flag list to vector of command flags } \examples{ theFunction <- function(...){cmd_args_all()} theArgs <- theFunction(arg1 = "value", arg2 = TRUE) flagList <- cmd_list_interp(theArgs) flags <- cmd_list_to_flags(flagList) } cmdfun/DESCRIPTION0000644000176200001440000000260513740277433013251 0ustar liggesusersPackage: cmdfun Type: Package Title: Framework for Building Interfaces to Shell Commands Version: 1.0.2 Authors@R: person("Spencer", "Nystrom", email = "nystromdev@gmail.com", role = c("aut", "cre", "cph"), comment = c(ORCID = "0000-0003-1000-1579")) Description: Writing interfaces to command line software is cumbersome. 'cmdfun' provides a framework for building function calls to seamlessly interface with shell commands by allowing lazy evaluation of command line arguments. 'cmdfun' also provides methods for handling user-specific paths to tool installs or secrets like API keys. Its focus is to equally serve package builders who wish to wrap command line software, and to help analysts stay inside R when they might usually leave to execute non-R software. License: MIT + file LICENSE Encoding: UTF-8 LazyData: true Imports: magrittr, purrr, R.utils, rlang, testthat, usethis, utils RoxygenNote: 7.0.2 Suggests: cli, covr, knitr, processx, rmarkdown VignetteBuilder: knitr URL: https://snystrom.github.io/cmdfun/, https://github.com/snystrom/cmdfun BugReports: https://github.com/snystrom/cmdfun NeedsCompilation: no Packaged: 2020-10-02 14:16:21 UTC; snystrom Author: Spencer Nystrom [aut, cre, cph] () Maintainer: Spencer Nystrom Repository: CRAN Date/Publication: 2020-10-10 09:30:03 UTC cmdfun/build/0000755000176200001440000000000013735633064012637 5ustar liggesuserscmdfun/build/vignette.rds0000644000176200001440000000030213735633064015171 0ustar liggesusersb```b`fcb`b2 1# 'JMI+ MAaȠrCgIq*  :ּb4.y) 3G;<E T [fN*ސ89 d Bw(,/׃ @?{49'ݣ\)%ziE@ w߀cmdfun/tests/0000755000176200001440000000000013710700307012666 5ustar liggesuserscmdfun/tests/testthat/0000755000176200001440000000000013740277433014542 5ustar liggesuserscmdfun/tests/testthat/helper-build_macro.R0000644000176200001440000000154513721572774020434 0ustar liggesusers build_valid_path <- function(path = NULL, utils = NULL){ basePath <- sanitize_path(file.path(tempdir(), path)) dir.create(basePath, showWarnings = F) utilPaths <- utils if (!is.null(utils)){ utilPaths <- file.path(basePath, utils) file.create(utilPaths) names(utilPaths) <- utils } allPaths <- c("base" = basePath, utilPaths) return(allPaths) } cleanup_valid_path <- function(allPaths){ stopifnot("base" %in% names(allPaths)) unlink(allPaths["base"], recursive = T) } allUtils <- c("tool1", "tool2", "tool3") supportedUtils <- c("tool1", "tool2") unsupportedUtils <- "tool3" myUtils <- supportedUtils check_paths <- build_valid_path("tests", allUtils) base_path <- check_paths["base"] names(base_path) <- NULL double_assign <- c("one", "two") test_option <- "dotargs_test_option" test_env_var <- "DOTARGS_TEST" cmdfun/tests/testthat/test_parse-help.R0000644000176200001440000000513313721046740017760 0ustar liggesuserscontext("Parse Help Flags") test_that("Suggestions work",{ valid_flags <- c("out", "threshold", "version") flagList <- list("out" = 2, "thresold" = 10, "version" = "v1") expect_equal(cmd_help_flags_similar(valid_flags, names(flagList)), c("thresold" = "threshold")) expect_error(cmd_help_flags_similar(valid_flags, names(flagList)) %>% cmd_help_flags_suggest(), "Did you mean:", class = "error") expect_null(cmd_help_flags_similar(valid_flags, c())) expect_null(cmd_help_flags_similar(valid_flags, list())) flagList <- list("out" = 2, "threshold" = 10, "version" = "v1", "logn-name" = 2) expect_equal(cmd_help_flags_similar(c(valid_flags, "long-name"), names(flagList), ~{gsub("-", "_", .x)}), c("logn_name" = "long_name")) # big edit distance > 3 resolves to ??? cmd_help_flags_similar(valid_flags, names(flagList)) expect_equal(cmd_help_flags_similar(valid_flags, names(flagList)), c("logn-name" = "???")) }) test_that("Parsing Help Works", { helplines <- c(" --version prints the version name", " -e prints the e-value", " --outdir the output directory", "blah --anotherflag" ) expect_equal(cmd_help_parse_flags(helplines), c("version", "outdir", "e")) processxLines <- c(" --version prints the version name\n -e prints the e-value\n --outdir the output directory\n blah --anotherflag") expect_equal(cmd_help_parse_flags(processxLines, split_newline = TRUE), c("version", "outdir", "e")) }) test_that("Parsing Help Works with long/short combo", { # -e , --evalue checks that it can grab both with short/long orientation # --outdir, -o checks it can grab with long/short orientation helplines <- c(" --version prints the version name", " -e, --evalue prints the e-value", " --outdir, -o the output directory", "blah --anotherflag" ) expect_equal(cmd_help_parse_flags(helplines), c("version", "evalue", "outdir", "e", "o")) processxLines <- c(" --version prints the version name\n -e, --evalue prints the e-value\n --outdir, -o the output directory\n blah --anotherflag") expect_equal(cmd_help_parse_flags(processxLines, split_newline = TRUE), c("version", "evalue", "outdir", "e", "o")) }) test_that("Suggestion Error behaves correctly",{ # No error if no suggestions expect_null(cmd_help_flags_suggest(NULL)) expect_error(cmd_help_flags_suggest(c("tst" = "test")), "Did you mean", class = "error") expect_error(cmd_help_flags_suggest(c("tst" = "test")), class = "usethis_error") }) cmdfun/tests/testthat/test_argsToFlags.R0000644000176200001440000000716413717747123020152 0ustar liggesusers#library(cmdfun) ## TODO: format tests inside test_that() # test empty list expect_equal(cmd_list_interp(list()), NULL) # test named but NULL expect_equal(cmd_list_interp(list("test" = NULL)), NULL) # test NA values expect_equal(cmd_list_interp(list("arg" = NA)), NULL) # Test list vs vec expect_success(cmd_list_interp(list("a" = 1))) expect_failure(cmd_list_interp(c("a" = 1))) # Null is dropped like FALSE expect_equal(cmd_list_interp(list("b" = NULL)), cmd_list_interp(list("b" = FALSE))) # Test multiple inputs sep default is "," expect_equal(cmd_list_interp(list("a" = c(1,2,3))) %>% cmd_list_to_flags(), c("-a", "1,2,3")) # Test multiple inputs w/ NULL sep expect_equal(cmd_list_interp(list("a" = c(1,2,3))) %>% cmd_list_to_flags(sep = NULL), c("-a", "1", "2", "3")) # Test multiple inputs w/ comma sep expect_equal(cmd_list_interp(list("a" = c(1,2,3))) %>% cmd_list_to_flags(sep = ","), c("-a", "1,2,3")) # test quo vs unquoted names, all combinations expect_success(cmd_list_interp(list("a" = 1, "b" = T, "c" = F, d = 1, e = T, f = F))) expect_equal( cmd_list_interp(list("a" = 2, "b"= T, "x" = "x", "c" = NULL, "d" = F)), list("a" = 2, "b" = "", "x" = "x") ) # pass non-list to dotsToArgs expect_equal(cmd_list_interp(list("a" = 2)), list("a" = 2)) expect_equal(cmd_list_interp(list("a" = 2, "b" = 3, "c" = 4)) %>% cmd_list_to_flags(), c("-a", "2", "-b", "3", "-c", "4")) # Check False gets dropped correctly for list and vector expect_equal(cmd_list_interp(list("a" = 2, "b" = T, "c" = F)), list("a" = 2, "b" = "")) expect_equal(cmd_list_interp(list("a" = 2, "b" = T, "c" = F, "d" = c(1,3,"test"))), list("a" = 2, "b" = "", "d" = c("1","3","test"))) expect_equal(cmd_list_interp(list("a" = 2, "b" = T, "c" = F)) %>% cmd_list_to_flags(), c("-a", "2", "-b")) expect_equal(cmd_list_interp(list("a" = 2, "b" = T, "c" = F, "d" = c(1,3,"test"))) %>% cmd_list_to_flags(), c("-a" ,"2", "-b", "-d", "1,3,test")) # Input must be named, should be caught by internal checking expect_error(cmd_list_interp(list(2,3)), class = "expectation_failure") expect_error(cmd_list_interp(c(2,3)), class = "expectation_failure") # Dictionary tests argsDict <- c("long1" = "l", "long2" = "ll") argsDict_bool <- c(argsDict, test = T) ## List & vector (modify when conversion complete to warn, etc.) expect_equal(cmd_list_interp(list("long1" = 2, "long2" = T), argsDict), list("l"= 2, "ll" = "")) ## Should warn if dict contains BOOL values, invalid entry expect_warning(cmd_list_interp(list("a" = 2), argsDict_bool)) expect_warning(cmd_list_interp(list("long1" = 2, "long2" = T, "test" = "abc"), argsDict_bool)) ## should warn if flag has both T & F ? #expect_warning(dotsToArgs(list("b" = T, "b" = F))) ## should warn if flag has both T & F (with dictionary) #expect_warning(dotsToArgs(list("long1" = T, "long1" = F), argsDict)) ## Should also catch if long & short version of flags are both set expect_equal(cmd_list_interp(list("long1" = 2, "l" = T)), list("long1" = 2, "l" = "")) expect_message(cmd_list_interp(list("long1" = 2, "l" = T), argsDict)) expect_message(cmd_list_interp(list("l" = T, "l" = T), argsDict)) expect_message(cmd_list_interp(list("l" = T, "l" = T))) test_that("Illegal flags detected", { expect_error(cmd_list_interp(list("&&echo" = "test"))) expect_error(cmd_list_interp(list("$(echo hello world)" = T))) expect_error(cmd_list_interp(list("test flag" = T))) expect_error(cmd_list_interp(list("<(cat.)" = T))) }) test_that("to_flags works", { expect_null(cmd_list_to_flags(list())) expect_error(cmd_list_to_flags()) }) cmdfun/tests/testthat/test_internal.R0000644000176200001440000000000013717746637017541 0ustar liggesuserscmdfun/tests/testthat/test_build_macro.R0000644000176200001440000001543113721573424020206 0ustar liggesuserstest_that("warn at least 1 var not assigned", { expect_warning(cmd_path_search(), "at least one") expect_warning(cmd_path_search(environment_var = NULL), "at least one") expect_warning(cmd_path_search(option_name = NULL), "at least one") expect_warning(cmd_path_search(default_path = NULL), "at least one") }) test_that("At least 1 path is defined at calltime", { expect_warning(build_check <- cmd_path_search()) expect_error(build_check(), "No path defined or detected") }) test_that("Catches double assignment",{ expect_error( cmd_path_search(environment_var = double_assign), "environment_var must contain" ) expect_error( cmd_path_search(option_name = double_assign), "option_name must contain" ) expect_error( cmd_path_search(default_path = double_assign), "default_path must contain" ) # utils can have many values expect_success( cmd_path_search(default_path = tempdir(), utils = double_assign) ) }) test_that("Default path only, noUtils works",{ expect_warning( check_build <- cmd_path_search(environment_var = NULL, option_name = NULL, default_path = NULL) ) expect_equal(check_build(base_path), cmdfun:::sanitize_path(base_path)) expect_error(check_build(base_path, util = myUtils[1]), "no defined utils") }) test_that("Passing invalid user path throws error", { check_build <- cmd_path_search(environment_var = NULL, option_name = NULL, default_path = base_path, utils = myUtils) expect_equal(check_build(), cmdfun:::sanitize_path(base_path)) expect_error(check_build("bad/path"), "does not exist") }) test_that("Defining & checking utils works", { check_build <- cmd_path_search(environment_var = NULL, option_name = NULL, default_path = base_path, utils = myUtils) expect_equal(check_build(), cmdfun:::sanitize_path(base_path)) expect_equal(check_build(base_path, util = myUtils[1]), cmdfun:::sanitize_path(file.path(base_path, myUtils[1]))) # Expect errror with many utils expect_error(check_build(base_path, util = myUtils), "util must be NULL or length 1") }) test_that("Options definition works",{ check_build <- cmd_path_search(environment_var = NULL, option_name = test_option, default_path = "bad/path", utils = myUtils) expect_error(check_build(), "bad/path, does not exist") R.utils::setOption(test_option, base_path) expect_equal(check_build(), cmdfun:::sanitize_path(base_path)) expect_equal(check_build(util = myUtils[1]), cmdfun:::sanitize_path(file.path(base_path, myUtils[1]))) # Test inheritance of default w/ bad option R.utils::setOption(test_option, "wrong_path") expect_error(check_build(), "bad/path, does not exist") R.utils::setOption(test_option, NULL) }) test_that("Environment definition works", { check_build <- cmd_path_search(environment_var = test_env_var, utils = myUtils) expect_error(check_build(), "No path defined or detected") Sys.setenv(test_env_var = base_path) check_build <- cmd_path_search(environment_var = test_env_var, utils = myUtils) expect_equal(check_build(base_path), cmdfun:::sanitize_path(base_path)) expect_equal(check_build(base_path, util = myUtils[1]), cmdfun:::sanitize_path(file.path(base_path, myUtils[1]))) # Test inheritance of default w/ bad environment var Sys.setenv(test_env_var = "wrong_path") check_build <- cmd_path_search(environment_var = test_env_var, default_path = "bad/path") expect_error(check_build(), "bad/path, does not exist") Sys.setenv(test_env_var = "") }) test_that("Util warnings work", { expect_equal(.check_valid_util(util = myUtils[1], utils = myUtils, path = base_path), cmdfun:::sanitize_path(file.path(base_path, myUtils[1]))) expect_error(.check_valid_util(util = "badUtil", utils = myUtils, path = base_path), "invalid path to an unsupported") expect_warning(.check_valid_util(util = allUtils[3], utils = myUtils, path = base_path), "exists but is not supported") # error when tool supported but not exist expect_error(.check_valid_util(util = "tool4", utils = c(myUtils, "tool4"), path = base_path), "invalid path to supported") }) test_that("util listing works", { check_build <- cmd_path_search(environment_var = NULL, option_name = NULL, default_path = base_path, utils = myUtils) valid_utils <- check_paths[2:3] names(valid_utils) <- NULL expect_equal(check_build(util = TRUE), valid_utils) }) test_that("is_valid_install behaves correctly", { check_build_good <- cmd_path_search(environment_var = NULL, option_name = NULL, default_path = base_path, utils = myUtils) is_valid <- cmd_install_is_valid(check_build_good) is_valid_util <- cmd_install_is_valid(check_build_good, util = myUtils[1]) is_valid_util_bad <- cmd_install_is_valid(is_valid_good, util = 'bad_tool') expect_true(is_valid()) expect_true(is_valid_util()) expect_false(is_valid_util_bad()) expect_false(is_valid('bad/path')) expect_false(is_valid_util('bad/path')) expect_false(suppressWarnings(is_valid_util_bad('bad/path'))) }) test_that("cmd_install_check works", { context("Check works with utils") check_build <- cmd_path_search(environment_var = NULL, option_name = NULL, default_path = base_path, utils = myUtils) expect_invisible(cmd_install_check(check_build)) expect_message(cmd_install_check(check_build), "main install") expect_message(cmd_install_check(check_build), "util install") expect_error(cmd_install_check('bad value'), "must be a function") context("Check works without utils") check_build_noutil <- cmd_path_search(environment_var = NULL, option_name = NULL, default_path = base_path) expect_invisible(cmd_install_check(check_build_noutil)) expect_message(cmd_install_check(check_build_noutil), "main install") context("works when main is bad") expect_invisible(cmd_install_check(check_build, "bad/path")) expect_message(cmd_install_check(check_build, "bad/path"), cli::symbol$cross) }) teardown({ # Cleanup temp dir & files cleanup_valid_path(check_paths) }) cmdfun/tests/testthat/test_file-exists.R0000644000176200001440000000155313717746637020177 0ustar liggesusersteardown({ file.remove(exist_file) purrr::walk(exist_file_list, file.remove) }) test_that("Test files as expected", { expect_true(file.exists(exist_file)) expect_true(all(file.exists(exist_file_vector))) expect_false(file.exists(bad_file)) }) test_that("Test file utils work", { expect_invisible(cmd_error_if_missing(exist_file_list)) expect_invisible(cmd_error_if_missing(exist_file_vector)) expect_invisible(cmd_error_if_missing(exist_file)) expect_error(cmd_error_if_missing(bad_file), "was not found") }) test_that("UI file exists works", { expect_invisible(cmd_ui_file_exists(exist_file)) expect_message(cmd_ui_file_exists(exist_file), cli::symbol$tick) expect_message(cmd_ui_file_exists(bad_file), cli::symbol$cross) expect_error(cmd_ui_file_exists(exist_file_vector), "length 1") expect_error(cmd_ui_file_exists(exist_file_list)) }) cmdfun/tests/testthat/test_expect-outputs.R0000644000176200001440000000442613721574537020747 0ustar liggesuserstest_that("cmd_file_expect works", { expect_equal(cmd_file_expect(exist_prefix, exist_ext, outdir = dir), exist_file_combn_list) expect_error(cmd_file_expect(exist_prefix, exist_ext, outdir = "bad/dir")) }) test_that("cmd_file_combn Generates correct names",{ context("1 file, many ext") expect_equal(cmd_file_combn("myFile", c("txt", "ext", "xml")), list(txt = "./myFile.txt", ext = "./myFile.ext", xml = "./myFile.xml")) context("many files, 1 ext") expect_equal(cmd_file_combn(c("myFile", "myFile1", "myFile2"), "txt"), list(myFile = "./myFile.txt", myFile1 = "./myFile1.txt", myFile2 = "./myFile2.txt")) context("many files, many ext") out_expected <- list("a.txt" = "./a.txt", "a.csv" = "./a.csv", "b.txt" = "./b.txt", "b.csv" = "./b.csv") expect_equal(cmd_file_combn(c("a", "b"), c("txt", "csv")), out_expected) }) test_that("Outdir works",{ expect_equal( cmd_file_combn("myFile", "txt", outdir = "test/test"), cmd_file_combn("myFile", "txt", outdir = "test/test/") ) expect_equal( cmd_file_combn("myFile", "txt", outdir = "test/test"), list("txt" = "test/test/myFile.txt") ) }) test_that("combn commands work", { expect_equal(combn_prefix_suffix(c("a", "b"), c(1,2)), c("a.1", "a.2", "b.1", "b.2")) expect_equal(combn_prefix_suffix(c("a", "b", "c"), c(1,2)), c("a.1", "a.2", "b.1", "b.2", "c.1", "c.2")) expect_equal(combn_prefix_suffix(c("a", "b", "c"), c(1,2,3)), c("a.1", "a.2", "a.3", "b.1", "b.2", "b.3", "c.1", "c.2", "c.3")) }) test_that("combn utils work", { context("merge_combn_vector") expect_equal(merge_combn_vector(c("1", "2")), "1.2") expect_equal(merge_combn_vector(1:2), "1.2") expect_error(merge_combn_vector(1:3), "length") expect_error(merge_combn_vector(1), "length") context("combine_and_merge") # single vector expect_equal(combine_and_merge(1:3), c("1.2", "1.3", "2.3")) # nested vector expect_equal(combine_and_merge(c(c("a", "b"), c(1,2))), c("a.b", "a.1", "a.2", "b.1", "b.2", "1.2")) }) cmdfun/tests/testthat/test_utils.R0000644000176200001440000000655013721571010017055 0ustar liggesusers test_that("Can detect illegal flags", { expect_false(flag_is_illegal("a")) expect_true(flag_is_illegal("&echo")) expect_true(flag_is_illegal("@echo")) }) test_that("drop flags", { flags <- list("arg1" = "test", "arg2" = "dontdrop", "arg2" = "dropMe") expect_equal(cmd_list_drop(flags, c("")), flags) expect_equal(cmd_list_drop(flags, c("these", "dont", "exist")), flags) expect_equal(cmd_list_drop(flags, 3), flags[c(1,2)]) expect_equal(cmd_list_drop(flags, c(2,3)), flags[1]) expect_equal(cmd_list_drop(flags, c("arg2")), list(arg1 = "test")) expect_equal(cmd_list_drop(flags, c("arg2" = "dropMe")), list(arg1 = "test", arg2 = "dontdrop")) expect_equal(cmd_list_drop(flags, c("arg2" = "DROOE")), flags) expect_equal(cmd_list_drop(flags, c("arg2" = "DROOE", "arg2" = "dropMe")), list(arg1 = "test", arg2 = "dontdrop")) moreFlags <- list(arg1 = "test", arg2 = "arg2", "arg2" = "test") expect_warning(cmd_list_drop(moreFlags, c("arg1" = "test", "arg2")), "values have no names") expect_equal( suppressWarnings(cmd_list_drop(moreFlags, c("arg1" = "test", "arg2"))), list(arg2 = "arg2", "arg2" = "test") ) }) test_that("keep flags", { flags <- list("arg1" = "test", "arg2" = "dontdrop", "arg2" = "dropMe") expect_equal(cmd_list_keep(flags, c("")), list()) expect_equal(cmd_list_keep(flags, c("these", "dont", "exist")), list()) expect_equal(cmd_list_keep(flags, 3), flags[3]) expect_equal(cmd_list_keep(flags, c(2,3)), flags[c(2,3)]) expect_equal(cmd_list_keep(flags, c("arg2")), list(arg2 = "dontdrop", arg2 = "dropMe")) expect_equal(cmd_list_keep(flags, c("arg2" = "dropMe")), list(arg2 = "dropMe")) expect_equal(cmd_list_keep(flags, c("arg2" = "DROOE")), list()) expect_equal(cmd_list_keep(flags, c("arg2" = "DROOE", "arg2" = "dropMe")), list(arg2 = "dropMe")) moreFlags <- list(arg1 = "test", arg2 = "arg2", "arg2" = "test") expect_warning(cmd_list_keep(moreFlags, c("arg1" = "test", "arg2")), "values have no names") expect_equal( suppressWarnings(cmd_list_keep(moreFlags, c("arg1" = "test", "arg2"))), list(arg1 = "test") ) }) # These may be tested implicitly in above new tests test_that("internal list helpers work",{ myList <- list("one" = 1, "two" = 1, "three" = 1, "three" = 2) expect_null(list_index_names(myList, NULL)) expect_equal(list_index_names(myList, c("one")), 1) expect_equal(list_index_names(myList, c("one", "three")), c(1,3, 4)) expect_equal(cmd_list_keep_named(myList, "one"), myList[1]) expect_equal(cmd_list_drop_named(myList, "one"), myList[c(2,3,4)]) expect_equal(list_index_named_values(myList, c("three" = 1)), 3) expect_equal(list_index_named_values(myList, c("one" = 1, "three" = 1)), c(1,3)) context("ignores if NA values in named_values") expect_warning(list_index_named_values(myList, c("one" = NA, "three" = 1)), "have NA values and will be ignored") expect_equal(suppressWarnings(list_index_named_values(myList, c("one" = NA, "three" = 1))), 3) context("ignores unnamed values in input list") expect_equal(list_index_named_values(list(1, "one" = 1), c("one" = 1)), 2) }) test_that("file_not_exist error is invisible if NULL or empty", { expect_invisible(error_text_file_not_exist(NULL)) expect_invisible(error_text_file_not_exist(c())) }) cmdfun/tests/testthat/test_getArgs.R0000644000176200001440000000325613717747123017330 0ustar liggesusersnamed_test <- function(arg1, ...){ cmd_args_named() } all_test <- function(arg1, ...){ cmd_args_all() } dot_test <- function(arg1, ...){ cmd_args_dots() } pipe_test <- function(arg1, ...){ cmd_args_all() %>% cmd_list_interp() %>% cmd_list_to_flags() } pipe_test_named <- function(arg1, arg2, ...){ cmd_args_named() %>% cmd_list_interp() %>% cmd_list_to_flags() } keep_test <- function(arg1, arg2, ...){ cmd_args_all(keep = c("arg1", "dot_keep")) %>% cmd_list_interp() %>% cmd_list_to_flags() } drop_test <- function(arg1, arg2, ..){ cmd_args_all(drop = "arg2") %>% cmd_list_interp() %>% cmd_list_to_flags() } test_that("Can get Named Args", { expect_equal(named_test("a"), list("arg1" = "a")) }) test_that("Can get Dot Args", { expect_equal(dot_test("a", "b" = 2), list("b" = 2)) }) test_that("Can get All Args", { expect_equal(all_test("a", "b" = 2), list("arg1" = "a", "b" = 2)) }) test_that("Output is list", { expect_type(all_test(), "list") expect_type(named_test(), "list") expect_type(dot_test(), "list") }) test_that("Pipe works", { expect_equal(pipe_test("a"), c("-arg1", "a")) }) test_that("T/F Filtered", { expect_equal(pipe_test(T,arg2 = F), c("-arg1")) expect_equal(pipe_test(T,arg2 = T), c("-arg1", "-arg2")) expect_error(pipe_test_named(T,arg2 = T, arg2 = F), "formal argument \"arg2\"") }) test_that("Keep/drop works", { expect_null(drop_test()) expect_null(keep_test()) expect_equal(drop_test(arg1 = "test", arg2 = "drop"), c("-arg1", "test")) expect_equal(keep_test(arg1 = "test", arg2 = "drop", dot_keep = "value"), c("-arg1", "test", "-dot_keep", "value")) }) cmdfun/tests/testthat/helper-expect-outputs.R0000644000176200001440000000037313721574512021153 0ustar liggesusersdir <- tempdir() exist_prefix <- c("a", "b", "c") exist_ext <- c("txt") exist_file_combn_list <- cmd_file_combn(exist_prefix, exist_ext, dir) %T>% purrr::walk(file.create) bad_file <- tempfile() exist_file_vector <- unlist(exist_file_combn_list) cmdfun/tests/testthat/helper-file-exists.R0000644000176200001440000000031013717746636020402 0ustar liggesusersexist_file <- tempfile() file.create(exist_file) bad_file <- tempfile() exist_file_list <- purrr::map(1:3, ~{tempfile()}) %T>% purrr::map(file.create) exist_file_vector <- unlist(exist_file_list)cmdfun/tests/testthat.R0000644000176200001440000000011113710700307014642 0ustar liggesuserslibrary(testthat) library(cmdfun) library(magrittr) test_check("cmdfun")cmdfun/vignettes/0000755000176200001440000000000013735633065013551 5ustar liggesuserscmdfun/vignettes/cmdfun.Rmd0000644000176200001440000000103113735622423015460 0ustar liggesusers--- title: "cmdfun" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{cmdfun} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r, include = FALSE} knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ``` Please see the cmdfun website for full documentation: * In particular, a guide to building wrappers using cmdfun, complete with several examples, can be found here: * cmdfun/R/0000755000176200001440000000000013721046740011733 5ustar liggesuserscmdfun/R/utils.R0000644000176200001440000003272013735624264013232 0ustar liggesusers#' Keep items by name from list #' #' A pipe-friendly wrapper around `list[(names(list) %in% names]`. #' #' This function is slightly faster than using [cmd_list_keep()] to keep items #' by name. #' #' @param list an R list #' @param names vector of names to keep #' #' @return list keeping only items defined by names #' @export #' #' @examples #' cmd_list_keep_named(list("a" = 1, "b" = 2), "a") cmd_list_keep_named <- function(list, names){ list[(names(list) %in% names)] } #' Drop items by name from list #' #' A pipe-friendly wrapper around `list[!(names(list) %in% names)]` #' This function is slightly faster than using [cmd_list_drop()] to drop items #' by name. #' #' @param list an R list #' @param names vector of names to drop #' #' @return list removing items defined by names #' @export #' #' @examples #' cmd_list_drop_named(list("a" = 1, "b" = 2), "a") cmd_list_drop_named <- function(list, names){ list[!(names(list) %in% names)] } #' keep entries from list of flags by name, name/value pair, or index #' #' @param flags named list output of cmd_list_interp #' @param keep vector of flag entries to keep. Pass a character vector #' to keep flags by name. Pass a named vector to keep flags by name/value #' pairs. Pass a numeric vector to keep by position. #' #' @return flags list with values not in keep removed #' @export #' #' @examples #' exFlags <- list("flag1" = 2, "flag2" = "someText") #' cmd_list_keep(exFlags, "flag1") #' # will keep flag2 because its name and value match 'keep' vector #' cmd_list_keep(exFlags, c("flag2" = "someText")) #' # Will keep "flag1" by position index #' cmd_list_keep(exFlags, 1) #' #' # won't keep flag2 because its value isn't 'someText' #' exFlags2 <- list("flag1" = 2, "flag2" = "otherText") #' cmd_list_keep(exFlags, c("flag2" = "someText")) cmd_list_keep <- function(flags, keep){ testthat::expect_named(flags) if (length(keep) == 0){ return(list()) } if (is.numeric(keep)){ return(list_keep_index(flags, keep)) } if (is.null(names(keep))){ keeps <- list_index_names(flags, keep) return(cmd_list_keep(flags, keeps)) } if (!is.null(names(keep))) { keeps <- list_index_named_values(flags, keep) return(list_keep_index(flags, keeps)) } } #' Drop entries from list of flags by name, name/value pair, or index #' #' @param flags named list output of cmd_list_interp #' @param drop vector of flag entries to drop. Pass a character vector #' to drop flags by name. Pass a named vector to drop flags by name/value #' pairs. Pass a numeric vector to drop by position. #' #' @return flags list with values in drop removed #' @export #' #' @examples #' exFlags <- list("flag1" = 2, "flag2" = "someText") #' cmd_list_drop(exFlags, "flag1") #' # will drop flag2 because its name and value match 'drop' vector #' cmd_list_drop(exFlags, c("flag2" = "someText")) #' # Will drop "flag1" by position index #' cmd_list_drop(exFlags, 1) #' #' # won't drop flag2 because its value isn't 'someText' #' exFlags2 <- list("flag1" = 2, "flag2" = "otherText") #' cmd_list_drop(exFlags, c("flag2" = "someText")) cmd_list_drop <- function(flags, drop){ testthat::expect_named(flags) if (length(drop) == 0){ return(flags) } if (is.numeric(drop)){ return(list_drop_index(flags, drop)) } if (is.null(names(drop))){ drops <- list_index_names(flags, drop) return(cmd_list_drop(flags, drops)) } if (!is.null(names(drop))) { drops <- list_index_named_values(flags, drop) return(list_drop_index(flags, drops)) } } #' keeps list entry by positional index #' #' @param flags list of flags #' @param index position in list to keep #' #' @return flags kept at indices #' #' @examples #' #' @noRd list_keep_index <- function(flags, index){ if (length(index) == 0 | all(is.na(index))){ return(list()) } index <- index[!is.na(index)] flags[index] } #' drops list entry by positional index #' #' @param list a `list` #' @param index position in list to drop #' #' @return list w/ values dropped at indices #' #' @examples #' #' @noRd list_drop_index <- function(list, index){ if (length(index) == 0 | all(is.na(index))){ return(list) } index <- index[!is.na(index)] list[-index] } #' Return index of named list values #' #' @param list a named list #' @param names names of list entries #' #' @return vector of indices corresponding to named values matching names #' #' @examples #' #' @noRd list_index_names <- function(list, names){ i <- which(names(list) %in% names) names(i) <- NULL if (length(i) == 0) { return(NULL) } return(i) } #' Return index for list entry matching name & value #' #' #' #' @param list a named list #' @param named_values named character vector of list objects + their values to be matched. #' #' @return index in flags list with entries matching name/value pairs in named_values #' #' @examples #' myList <- list(a = 1, b = 2, b = 5) #' list_index_named_values(myList, c("b" = 5)) #' list_index_named_values(myList, c("b" = 2, "a" = 1)) #' #' @noRd list_index_named_values <- function(list, named_values){ testthat::expect_named(named_values) if (any(names(named_values) == "")){ warnVals <- named_values[names(named_values) == ""] warning(paste0("The following values have no names associated with them and will be ignored: ", warnVals)) } if (any(is.na(named_values))){ warnVals <- named_values[is.na(named_values)] warnNames <- names(warnVals) warning(paste0("The following names in named_values have NA values and will be ignored: ", warnNames)) } indices <- purrr::imap_int(named_values, ~{ i <- which(names(list) == .y & list == .x) names(i) <- NULL # NA will mean "no match" if (length(i) == 0){return(NA)} # ignore names of "" to avoid unexpected behavior if (.y == ""){return(NA)} return(i) }) %>% purrr::set_names(NULL) return(indices[!is.na(indices)]) } #' Check that file(s) exist, error if not #' #' @param files list or vector of paths to check #' #' @return nothing or error message for each missing file #' @export #' #' @importFrom magrittr %>% #' #' @examples #' cmd_error_if_missing(tempdir()) #' \dontrun{ #' # Throws error if file doesn't exist #' cmd_error_if_missing(file.path(tempdir(), "notreal")) #' } cmd_error_if_missing <- function(files){ if (length(files) > 1) { files %>% purrr::map(purrr::discard, file.exists) %>% purrr::compact() %>% error_text_file_not_exist %>% error_file_not_exist() } if (length(files) == 1) { if (!file.exists(files)) { files %>% error_text_file_not_exist() %>% error_file_not_exist() } else {return(invisible())} } } #' Generate error text that file doesn't exist #' #' This is such a stupid way to do things. #' #' @param file path to file or files (as vector) #' #' @return file doesn't exist error text #' #' @examples #' #' @noRd error_text_file_not_exist <- function(file){ # Ugh. I hate this. This whole error checking/validation system needs yet # another overhaul. if (is.null(file)){ return(invisible()) } if (length(file) == 0){ return(invisible()) } paste0(file, " was not found.", collapse = "\n") } #' Throw error that file doesn't exist #' #' This system needs fixing. #' #' @param file path to file #' #' @return file doesn't exist error #' @noRd #' #' @examples #' file %>% #' error_text_file_not_exist() %>% #' error_file_not_exist() error_file_not_exist <- function(text){ # No real error checking. if (is.null(text)){ return(invisible()) } stop(text) } #' Generates list of expected output files #' #' See documentation of cmd_file_expect() for more details about how this works #' #' @param ext file extension (no ".", ie "txt", "html") #' @param prefix file name to be given each ext. If a character vector, must be equal length of ext or shorter #' @param outdir optional directory where files should exist #' #' @return list of file paths by each ext or prefix (whichever is longer) #' @export #' #' @examples #' # Makes list for many file types of same prefix #' # ie myFile.txt, myFile.html, myFile.xml #' cmd_file_combn("myFile", c("txt", "html", "xml")) #' #' # Makes list for many files of same type #' # ie myFile1.txt, myFile2.txt, myFile3.txt #' cmd_file_combn(c("myFile1", "myFile2", "myFile3"), "txt") #' cmd_file_combn <- function(prefix, ext, outdir = "."){ # strip leading . from ext (ie allow .txt.gz or txt.gz) ext %<>% gsub("^\\.", "", .) if (length(prefix) > 1 & length(ext) > 1){ file_combn <- combn_prefix_suffix(prefix, ext) file_list <- file_combn %>% paste(outdir, ., sep = "/") %>% sanitize_path() %>% purrr::set_names(file_combn) %>% as.list() return(file_list) } files <- purrr::map2(ext, prefix, ~{ file.path(outdir, paste0(.y, ".", .x)) %>% sanitize_path() }) if (length(ext) < length(prefix)){ files %>% purrr::set_names(prefix) %>% return() } else { files %>% purrr::set_names(ext) %>% return() } } #' Create all pairwise combinations of two vectors, excluding self-pairs #' #' @param prefix #' @param suffix #' #' @return vector of all combinations of prefix + suffix #' @noRd #' #' @examples #' combn_prefix_suffix(c("one", "two", "three"), c(1,2)) #' # Compare vs output of: #' combine_and_merge(c(c("one", "two"), c(1,2)) combn_prefix_suffix <- function(prefix, suffix){ prefix %<>% as.character suffix %<>% as.character # taking combn of c(prefix, suffix) will result in prefix+prefix and suffix+suffix # entries (ie self-combinations), so these need to be subtracted out to # produce the final set of prefix+suffix entries self_combn <- list(prefix, suffix) %>% purrr::map(combine_and_merge) %>% unlist() prefix_suffix_combn <- c(prefix, suffix) %>% combine_and_merge() prefix_suffix_combn[!(prefix_suffix_combn %in% self_combn)] } #' Merge vector #' #' @param v vector of length 2 #' @param sep separator to join v[1] and v[2] #' #' @return #' @noRd #' #' @examples #' merge_combn_vector(c("one", "two")) merge_combn_vector <- function(v, sep = "."){ stopifnot(length(v) == 2) paste(v[1], v[2], sep = sep) } #' Create all pairwise combinations of vector entries & join on separator #' #' @param vector a vector to create all pairwise combinations of. Pass vector of #' vectors for matrix-wise operation. #' @param sep separator #' #' @return #' @noRd #' #' @examples #' combine_and_merge(1:3) #' combine_and_merge(c(c("one", "two"), c(1,2)) combine_and_merge <- function(vector, sep = "."){ utils::combn(vector, m = 2, simplify = FALSE) %>% purrr::map_chr(merge_combn_vector, sep = sep) } #' Creates list of paths by file extension & checks they exist #' #' Ext or prefix can be a vector or single character. The shorter value will be #' propagated across all values of the other. See Examples for details. #' #' If files are not found, throws an error #' #' @param prefix name of file prefix for each extension. #' @param ext vector of file extensions #' @param outdir directory the files will be inside #' #' @return vector of valid file paths #' @export #' #' @importFrom magrittr %T>% #' #' @examples #' \dontrun{ #' # Expects many file types of same prefix #' # ie myFile.txt, myFile.html, myFile.xml #' cmd_file_expect("myFile", c("txt", "html", "xml")) #' #' # Expects many files of same type #' # ie myFile1.txt, myFile2.txt, myFile3.txt #' cmd_file_expect(c("myFile1", "myFile2", "myFile3"), "txt") #' #' # Expects many files with each prefix and each extension #' # ie myFile1.txt, myFile1.html, myFile2.txt, myFile2.html #' cmd_file_expect(c("myFile1", "myFile2"), c("txt", "html")) #' #' } #' #' cmd_file_expect <- function(prefix, ext, outdir = "."){ cmd_file_combn(prefix, ext, outdir) %T>% cmd_error_if_missing() } #' Checks if file exists, returns pretty status message #' #' @param file path to file #' #' @return ui_done or ui_oops printed to terminal. #' @export #' #' @examples #' cmd_ui_file_exists("/path/to/file.txt") cmd_ui_file_exists <- function(file){ if (!class(file) == "character") { stop("file must be a character") } if (length(file) > 1) { stop("file must be length 1") } if (file.exists(file)) { usethis::ui_done(file) } else { usethis::ui_oops(file) } return(invisible(NULL)) } #' Wrapper function for checking an install #' #' This function can be lightly wrapped by package builders to build a user-friendly install checking function. #' #' @param path_search `function` output of `cmd_path_search()` #' @param path user-override path to check (identical to `path` argument of `cmd_path_search()` output) #' #' @return pretty printed message indicating whether files exits or not. Green check = Yes, red X = No. #' @export #' #' @examples #' \dontrun{ #' path_search <- cmd_path_search(default = "/bin", utils = "ls") #' cmd_install_check(path_search) #' } cmd_install_check <- function(path_search, path = NULL){ if (!is.function(path_search)) { stop("path_search must be a function") } message("checking main install") x <- try(path_search(path = path) %>% cmd_ui_file_exists(), silent = TRUE) if (class(x) == "try-error") { cmd_ui_file_exists(path) return(invisible(NULL)) } util_catch <- try(path_search(path = path, util = TRUE), silent = TRUE) has_utils <- class(util_catch) != "try-error" if (has_utils){ message("checking util installs") path_search(path = path, util = TRUE) %>% purrr::walk(cmd_ui_file_exists) return(invisible(NULL)) } } cmdfun/R/cmd_args.R0000644000176200001440000001420113721610263013630 0ustar liggesusers#' Return all named arguments and arguments passed as dots from parent function call #' #' @param keep name of arguments to keep #' @param drop name of arguments to drop (NOTE: keep or drop are mutually exclusive settings) #' #' @return named list of all arguments passed to parent #' @export #' #' @examples #' theFunction <- function(arg1, ...) { cmd_args_all() } #' theArgs <- theFunction(arg1 = "test", example = "hello") cmd_args_all <- function(keep = NULL, drop = NULL){ # Modified from: # https://stackoverflow.com/questions/17256834/getting-the-arguments-of-a-parent-function-in-r-with-names # using callstack position of parent call will always evaluate to function # this was called inside, this allows this to work inside pipes argList <- as.list(match.call(definition = sys.function(sys.parent()), call = sys.call(sys.parent()), #envir = parent.frame(), expand.dots = TRUE))[-1] # arguments from callstack need to be evaluated in parent environment. # eval's default is to execute in the parent frame of where it was called, # which in this case would be **within** the lapply loop. # setting envir = parent.frame() will evaluate **before** the loop, so the # environment will be the same as the match.call parent as intended. args <- lapply(argList, eval, envir = parent.frame()) list_keep_or_drop(args, keep = keep, drop = drop) } #' return function dots from parent function as named list #' #' #' @param keep name of arguments to keep #' @param drop name of arguments to drop (NOTE: keep or drop are mutually exclusive settings) #' #' @return named list of kwargs from ... #' @export #' #' @importFrom magrittr %>% #' #' @examples #' theFunction <- function(...) { cmd_args_dots() } #' theDots <- theFunction(example = "hello", boolFlag = TRUE, vectorFlag = c(1,2,3)) cmd_args_dots <- function(keep = NULL, drop = NULL){ argList <- as.list(match.call(definition = sys.function(sys.parent()), call = sys.call(sys.parent()), expand.dots = FALSE))[-1] args <- lapply(argList[["..."]], eval, envir = parent.frame()) list_keep_or_drop(args, keep = keep, drop = drop) } #' Return all named arguments from parent function call #' #' @param keep name of arguments to keep #' @param drop name of arguments to drop (NOTE: keep or drop are mutually exclusive settings) #' #' @return named list of all defined function arguments from parent #' @export #' #' @examples #' theFunction <- function(arg1, ...) { cmd_args_named() } #' theNamedArgs <- theFunction(arg1 = "test", example = "hello") cmd_args_named <- function(keep = NULL, drop = NULL){ # see getAllNamedArgs for explanation of how this chunk works argList <- as.list(match.call(definition = sys.function(sys.parent()), call = sys.call(sys.parent()), expand.dots = FALSE))[-1] args <- lapply(argList, eval, envir = parent.frame()) %>% cmd_list_drop_named("...") list_keep_or_drop(args, keep = keep, drop = drop) } #' Convert list of function arguments to list of command flags #' #' Function also handles error checking to ensure args contain valid data types, #' and looks for common usage mistakes. #' #' The list structure is more amenable to manipulation by package developers for #' advanced use before evaluating them to the command flags vector with #' cmd_list_to_flags(). #' #' @param args named list output from get*Args family of functions. #' @param flag_lookup optional named vector used to convert args to command flags #' #' @return named list #' @export #' #' @importFrom magrittr %>% #' @importFrom magrittr %<>% #' #' @examples #' theFunction <- function(...){cmd_args_all()} #' theArgs <- theFunction(arg1 = "value", arg2 = TRUE) #' flagList <- cmd_list_interp(theArgs) #' flags <- cmd_list_to_flags(flagList) cmd_list_interp <- function(args, flag_lookup = NULL){ testthat::expect_type(args, "list") if (length(args) == 0) { return(NULL) } testthat::expect_named(args) if (any(flag_lookup == "TRUE" | flag_lookup == "FALSE")) { warning("flag_lookup may contain boolean definitions, which could cause unexpected behavior") } if (!is.null(flag_lookup)) { args <- convert_names(args, flag_lookup) } if (is.null(flag_lookup)) { flag_lookup <- args_as_lookup(args) } # Check for illegal characters in args, print warning check_args_contain_illegal_flags(args) args %<>% # NULL flags should be removed drop_list_NULL() %>% # NA flags should be removed purrr::discard(~{all(is.na(.x))}) %>% # collapse logicals, T = include, replace for empty string true_to_empty() %>% # only FALSE logicals remain, so they are dropped drop_list_logicals() %>% # Remove anything with empty names (happens ) cmd_list_drop_named("") # Warn if arguments are defined multiple times purrr::imap_dbl(flag_lookup, count_matched_args, args) %>% purrr::set_names(concatenate_args(flag_lookup)) %>% find_multimatched_args() %>% purrr::walk(warn_multimatched_arg) if (length(args) == 0) {return(NULL)} return(args) } #' Convert flag list to vector of command flags #' #' @param flagList output from cmd_list_interp(). A named list where names #' correspond to flags and members correspond to the value for the flag. #' @param prefix flag prefix, usually "-" or "--". #' @param sep separator to use if flag has a vector of values (default: NULL). #' #' @return character vector of parsed commandline flags followed by their values #' @export #' #' @importFrom magrittr %>% #' #' @examples #' theFunction <- function(...){cmd_args_all()} #' theArgs <- theFunction(arg1 = "value", arg2 = TRUE) #' flagList <- cmd_list_interp(theArgs) #' flags <- cmd_list_to_flags(flagList) cmd_list_to_flags <- function(flagList, prefix = "-", sep = ","){ if (is.null(flagList)) return(NULL) if (length(flagList) == 0) return(NULL) testthat::expect_named(flagList) flags <- purrr::imap(flagList, ~{c(paste0(prefix, .y), paste0(.x, collapse = sep))}) %>% unlist() %>% purrr::set_names(NULL) flags <- flags[flags != ""] return(flags) } cmdfun/R/utils_internal.R0000644000176200001440000001633613717746325015136 0ustar liggesusersutils::globalVariables(".") #' Drops list members by function #' #' @param list any list object #' @param fun a function that evaluates to boolean value, used to filter members of list #' #' @return the same list without any entries with logical vectors #' #' #' @examples #' myList <- list(a = 1, b = TRUE, c = FALSE) #' # This will drop logicals from list #' drop_list_fun(myList, fun = is.logical) #' #' @noRd drop_list_fun <- function(list, fun){ testthat::expect_equal(class(fun), "function") list[!purrr::map_lgl(list, fun)] } #' Removes logical vectors from list objects #' #' @param list any list object #' #' @return the same list without any entries with logical vectors #' #' @examples #' myList <- list(a = 1, b = TRUE, c = FALSE) #' drop_list_logicals(myList) #' @noRd drop_list_logicals <- function(list){ drop_list_fun(list, is.logical) } #' Removes logical vectors from list objects #' #' @param list any list object #' #' @return the same list without any entries with logical vectors #' #' @examples #' myList <- list(a = 1, b = TRUE, c = FALSE, d = NULL) #' drop_list_NULL(myList) #' @noRd drop_list_NULL <- function(list){ drop_list_fun(list, is.null) } #' Replaces list entries of bool of specified value with empty strings #' #' @param list a list #' @param bool whether to convert TRUE or FALSE to empty string (default TRUE) #' #' @return same list with entries replaced #' #' #' @examples #' myList <- list(a = TRUE, b = FALSE) #' convert_logical_to_empty(myList) #' @noRd convert_logical_to_empty <- function(list, bool = TRUE){ list <- purrr::map(list, ~{ if (!is.logical(.x)) return(.x) if (.x == bool) return("") return(.x) }) } #' Replace list entries with boolean values of TRUE with empty string #' #' @param list a list #' #' @return list where entries with TRUE are replaced for "" #' #' @examples #' myList <- list(a = TRUE) #' \dontrun{ #' true_to_empty(myList) #' } #' @noRd true_to_empty <- function(list){ list <- convert_logical_to_empty(list, TRUE) return(list) } #' converts names of object (obj) to values of named vector (dict) #' #' @param obj list or vector #' @param dict named vector where names are converted to values #' #' @return #' #' @examples #' dict <- c("long" = "l") #' dots <- list("long" = 1, "a" = 1) #' \dontrun{ #' convert_names(dots, dict) #' } #' @noRd convert_names <- function(obj, dict){ testthat::expect_named(obj) testthat::expect_named(dict) names(obj)[names(obj) %in% names(dict)] <- dict[names(obj)[names(obj) %in% names(dict)]] return(obj) } #' count number of times dots contains match to long or short version of flag #' #' @param value value from argsDict entry #' @param name name of argsDict entry #' @param dots list of dots from getDots() #' #' @return count of matches to value or name (should be 1 or greater if set, 0 if not) #' #' @importFrom magrittr %>% #' #' @examples #' dict <- c("name" = "value") #' dots <- list("name" = 1, "value" = 1) #' \dontrun{ #' count_matched_args(dict[1], names(dict)[1], dots) #' } #' #' dict <- c("name" = "value") #' dots <- list("name" = 1) #' \dontrun{ #' count_matched_args(dict[1], names(dict)[1], dots) #' } #' @noRd count_matched_args <- function(value, name, dots){ names(dots) %in% c(value, name) %>% sum } #' returns list of named args with multiple definitions #' #' @param vec named vector output of count_matched_args #' #' @return names of args with matches > 1 #' #' @examples #' vec <- c("setArg" = 1, "unsetArg" = 0, "multiSetArg" = 3) #' \dontrun{ #' find_multimatched_args(vec) #' } #' @noRd find_multimatched_args <- function(vec){ testthat::expect_named(vec) names(vec[vec > 1]) } #' Prints message warning user of each argument that is defined multiple times in function call #' #' @param name name of arg #' #' @return #' #' @examples #' \dontrun{ #' warn_multimatched_arg("arg") #' } #' @noRd warn_multimatched_arg <- function(name){ message(paste0(name, " is set multiple times in function call, ensure this is correct behavior.")) } #' Combines key/value pairs from named vector by separator #' #' @param dict argsDict #' @param sep separator #' #' @return #' #' @examples #' dict <- c("name" = "val") #' \dontrun{ #' concatenate_args(dict) #' } #' @noRd concatenate_args <- function(dict, sep = "/"){ paste(names(dict), dict, sep = sep) } #' Searches for illegal values in string #' #' @param flag string #' @param illegal_chars vector of flags forbidden in string #' default values are: "&", "|", ";", "(", ")", "{", "}", "$", "\@", "/" #' @return Boolean value for each flag #' #' @examples #' \dontrun{ #' flag_is_illegal("&&echo") #' } #' @noRd flag_is_illegal <- function(flag, illegal_chars = c("&", "\\|", ";", "\\(", "\\)", "\\{", "\\}", "\\$", "\\@", "\\/", " ")){ any(purrr::map_lgl(illegal_chars, grepl, flag)) } #' Prints illegal flag warning for name #' #' @param name name containing illegal flag #' #' @return #' #' @examples #' \dontrun{ #' error_illegal_flag("&&echo") #' } #' @noRd error_illegal_flag <- function(name){ stop(paste0(name, " is not a valid flag name. Contains illegal character.")) } #' Checks dots for illegal flag names #' #' @param args list output of get*Args family function #' #' @return prints warning for each illegal flag #' #' @importFrom magrittr %>% #' #' @examples #' theFunction <- function(...) { cmd_args_dots() } #' theDots <- theFunction(validFlag = TRUE, `&illegalFlag` = "will error") #' \dontrun{ #' theArgs <- dotsToArgs(theDots) #' } #' @noRd check_args_contain_illegal_flags <- function(args){ is_illegal <- purrr::map_lgl(names(args), flag_is_illegal) %>% purrr::set_names(names(args)) illegals <- is_illegal[is_illegal == T] purrr::walk(names(illegals), error_illegal_flag) } #' Creates system-agnostic paths #' #' Used to expand path shortcuts (like ~), and make system-agnostic calls. #' In particular can be useful for trimming trailing slashes for path names. #' #' @param path file path #' #' @return sanitized file path #' #' @examples #' path <- "~/bin/" #' \dontrun{ #' sanitize_path(path) #' } #' @noRd sanitize_path <- function(path){ file.path(dirname(path), basename(path)) } #' Converts list of arguments to named vector #' #' This function is used when a lookup table isn't supplied for arguments converted to flags. #' Used to say "all args defined should be kept as their original definition" #' #' @param args output of get*Args family function #' #' @return #' #' @noRd args_as_lookup <- function(args){ flag_lookup <- names(args) names(flag_lookup) <- names(args) return(flag_lookup) } #' Drops or keeps items by name from list #' #' @param list a named list #' @param keep names to keep #' @param drop names to drop #' #' @return #' #' @noRd list_keep_or_drop <- function(list, keep = NULL, drop = NULL){ if (length(list) == 0){return(list)} testthat::expect_named(list) if (!is.null(keep) & !is.null(drop)) { stop("only one of keep or drop may be defined") } if (is.null(keep) & is.null(drop)) { return(list) } if (!is.null(keep)){ testthat::expect_type(keep, "character") filteredList <- cmd_list_keep(list, keep) } if (!is.null(drop)){ testthat::expect_type(drop, "character") filteredList <- cmd_list_drop(list, drop) } return(filteredList) }cmdfun/R/parse_help.R0000644000176200001440000002021213721610146014172 0ustar liggesusers#' Parses commandline help options to return vector of valid flag names #' #' When using cmdfun to write lazy shell wrappers, the user can easily mistype #' a commandline flag since there is not text completion. Some programs behave #' unexpectedly when flags are typed incorrectly, and for this reason return uninformative error messages. #' #' `cmd_help_parse_flags` tries to grab flags from --help documentation which #' can be used for error checking. It will try to parse flags following "-" or #' "--" while ignoring hyphenated words in help text. Although this should cover #' most use-cases, it may be necessary to write a custom help-text parser for #' nonstandard tools. Inspect this output **carefully** before proceeding. Most #' often, characters are leftover at the **end** of parsed names, which will #' require additional parsing. #' #' @seealso \code{\link{cmd_help_flags_similar}} \code{\link{cmd_help_flags_suggest}} #' #' @param help_lines `character` vector containing the output of "command #' --help", or similar output. Optional: pass either `stdout`, or `stderr` output from #' processx::run(), must set `processx = TRUE`. #' @param split_newline `logical(1)` if set to TRUE will split string on "\\n" before #' parsing (useful when parsing output from `processx`). #' #' @return character vector of flag names parsed from help text #' @export #' #' @examples #' if (.Platform$OS.type == "unix" & file.exists("/bin/tar")) { #' # below are two examples parsing the --help method of GNU tar #' #' # with processx #' if (require(processx)) { #' out <- processx::run("tar", "--help", error_on_status = FALSE) #' fn_flags <- cmd_help_parse_flags(out$stdout, split_newline = TRUE) #' } #' #' # with system2 #' lines <- system2("tar", "--help", stderr = TRUE) #' fn_flags <- cmd_help_parse_flags(lines) #' #' # NOTE: some of the "tar" flags contain the extra characters: "\\[", "\\)", and ";" #' # ie "one-top-level\[" which should be "one-top-level" #' # These can be additionally parsed using #' gsub("[\\[;\\)]", "", fn_flags) #' } #' cmd_help_parse_flags <- function(help_lines, split_newline = FALSE){ stopifnot(is.logical(split_newline)) if (split_newline){ help_lines <- strsplit(help_lines, "\n")[[1]] } help_lines %>% help_flags_all() %>% help_flag_names } #' Get flag names from parsed lines #' #' @param lines parsed flag lines where 1st word on each line is the flag name #' #' @return character vector of flag names #' @noRd help_flag_names <- function(lines){ strsplit(lines, " ") %>% purrr::map_chr(~{ .x[[1]] }) %>% unique } #' Get vector of help lines for short (-) and long (--) flag definitions #' #' @param lines unprocessed help lines (with newlines trimmed if needed) #' #' @return a vector where each entry is a line where the first word is the flag name #' @noRd help_flags_all <- function(lines){ # Preprocess lines parsed_lines <- lines %>% # drop leading whitespace gsub("^ +", "", .) %>% # grab lines beginning with flag prefix grep("^-{1,2}[^-]", ., value = TRUE) %>% # parse - and -- flag entries, and put at beginning of line # combine into single vector for further processing { c(help_flags_long(.), help_flags_short(.)) } %>% # remove flag prefix gsub("^-+", "", .) %>% # remove leading whitespace # in case help file uses an unusual prefix # I've seen this for some windows CMD help pages. gsub("^ +", "", .) %>% # Drop empty lines gsub("^$", "", .) %>% # Drop text after = gsub("=.+", "", .) %>% # Remove commas gsub(",", "", .) return(parsed_lines) } #' Return "short" (-) flag definition lines #' #' @param cleaned_lines vector of preprocessed help lines #' #' @return vector of lines where first word is a flag defined with - #' @noRd help_flags_short <- function(cleaned_lines){ cleaned_lines %>% # remove up to flag prefix (-) gsub("^-{2}.+ -", "-", .) %>% # Keep any single - flags grep("^-{1}[^-]", ., value = TRUE) } #' Return "long" (--) flag definition lines #' #' @param cleaned_lines #' #' @return vector of lines where first word is a flag defined with -- #' @noRd help_flags_long <- function(cleaned_lines){ cleaned_lines %>% # remove up to flag prefix (--) gsub(".+ --", "--", .) %>% # Drop any single - flags grep("^-{1}[^-]", ., invert = TRUE, value = TRUE) } #' Suggest alternative name by minimizing Levenshtein edit distance between valid and invalid arguments #' #' @param command_flag_names character vector of valid names (can be output of \code{\link{cmd_help_parse_flags}}) #' @param flags a vector names correspond to values to be checked against `command_flag_names` #' @param .fun optional function to apply to `command_flag_names` and `flags` #' before checking their values. If using a function to rename flags after #' `cmd_list_interp`, use that same function here. Can be useful for parsing help #' lines into R-friendly variable names for user-convenience. Can be function #' or `rlang`-style formula definition (ie `.fun = ~{foo(.x)}` is the same as #' `.fun = function(x){foo(x)}`). Note: if command_flag_names need additional #' parsing after \code{\link{cmd_help_parse_flags}}, it is best to do that #' preprocessing before passing them to this function. #' @param distance_cutoff Levenshtein edit distance beyond which to suggest #' ??? instead of most similar argument (default = 3). Setting this too #' liberally will result in nonsensical suggestions. #' #' @return named vector where names are names from `flags` and their values are the suggested best match from `command_flag_names` #' @export #' #' @importFrom utils adist #' #' @examples #' # with a flagsList, need to pass names() #' flagsList <- list("output" = "somevalue", "missplld" = "anotherValue") #' cmd_help_flags_similar(c("output", "misspelled"), names(flagsList)) #' #' command_flags <- c("long-flag-name") #' flags <- c("long_flag_naee") #' cmd_help_flags_similar(command_flags, flags, .fun = ~{gsub("-", "_", .x)}) #' #' # returns NULL if no errors #' cmd_help_flags_similar(c("test"), "test") cmd_help_flags_similar <- function(command_flag_names, flags, .fun = NULL, distance_cutoff = 3L){ if (!is.null(.fun)){ if (class(.fun) == "formula"){.fun <- rlang::as_function(.fun)} stopifnot(is.function(.fun)) command_flag_names <- .fun(command_flag_names) flags <- .fun(flags) } bad_flags <- flags[!flags %in% command_flag_names] if (length(bad_flags) == 0) {return(NULL)} flag_dist <- adist(bad_flags, command_flag_names) # Only suggest names similar enough to existing flag, # otherwise return ??? for match. # distance_cutoff is the levenshtein edit distance threshold # drop_distance is a special value for things to be dropped. Because I minimize edit distance, # drop_distance needs to be a value larger than the cutoff (as low as distance_cutoff + 1) drop_distance <- distance_cutoff + 1L flag_dist[flag_dist > distance_cutoff] <- drop_distance i <- apply(flag_dist, 1, function(x) {which(x == min(x))[1]}) drop <- apply(flag_dist, 1, function(x) {which(min(x) == drop_distance)[1]}) suggest_flags <- command_flag_names[i] names(suggest_flags) <- bad_flags suggest_flags[!is.na(drop)] <- "???" return(suggest_flags) } #' Error & Suggest different flag name to user #' #' @param suggest_names named character vector, names correspond to original #' value, values correspond to suggested replacement. #' #' @return error message suggesting alternatives to user #' @export #' #' @examples #' user_flags <- list("output", "inpt") #' valid_flags <- c("output", "input") #' suggestions <- cmd_help_flags_similar(valid_flags, user_flags) #' \dontrun{ #' # Throws error #' cmd_help_flags_suggest(suggestions) #' } cmd_help_flags_suggest <- function(suggest_names){ if (is.null(suggest_names)){return(NULL)} quote_name <- function(name) paste0("\"", name, "\"") suggestString <- paste(quote_name(suggest_names), quote_name(names(suggest_names)), sep = " instead of: ", collapse = "\n") usethis::ui_stop(paste0("\nInvalid flags. Did you mean:\n", suggestString)) } cmdfun/R/macros.R0000644000176200001440000002613213721610422013340 0ustar liggesusers#' Macro for constructing target path validators #' #' A common pattern in designing shell interfaces is to ask the user to give an #' absolute path to the target shell utility. It is common to pass this #' information from the user to R by using either R environment variables #' defined in .Renviron, using options (set with option(), and got with #' getOption()), having the user explicitly pass the path in the function call, #' or failing this, using a default install path. #' #' Another common use-case involves software packages with many tools packaged #' in a single directory, and the user may want to call one or many utilities #' within this common structure. #' #' For example, the software "coolpackage" is installed in "~/coolpackage", and #' has two programs: "tool1", and "tool2" found in "~/coolpackage/tool1" and #' ~/coolpackage/tool2", respectively. #' #' To design an interface to coolpackage, this function can automate checking #' and validation for not only the package, but for each desired utility in the #' package. #' #' The hierarchy of path usage is: user-defined > option_name > environment_var > default_path #' #' #' #' @param environment_var name of R environment variable defining target path. Can be set in .Renviron. #' @param option_name name of user-configurable option (called by getOption) which will hold path to target #' @param default_path default install path of target. Can contain shell #' specials like "~" which will be expanded at runtime (as opposed to build time of the search function). #' @param utils optional character vector containing names of valid utils inside #' target path, used to populate error checking for valid install. #' #' @return function that returns a valid path to tool or optional utility. #' #' The returned path_search function takes as input a path or util. where path #' is a user override path for the supported tool. If the user-defined path is #' invalid, this will always throw an error and not search the defined defaults. #' #' util must be found within the target path, but does not have to be present in #' the original "utils" call. The user will be warned if this is the case. If #' `util` is set to `TRUE` will return all paths to utilities without checking #' the install. This can be used for writing user-facing install checkers. #' #' #' @export #' #' @examples #' if (.Platform$OS.type == "unix") { #' bin_checker <- cmd_path_search(default_path = "/bin", utils = c("ls", "pwd")) #' # returns path to bin #' bin_checker() #' # returns path to bin/ls #' bin_checker(util = "ls") #' } cmd_path_search <- function(environment_var = NULL, option_name = NULL, default_path = NULL, utils = NULL){ if (is.null(environment_var) & is.null(option_name) & is.null(default_path)){ warning("at least one of: environment_var, option_name, default_path is not assigned, user must manually set path") } # The following strategy fails because of lazy evalutation of function args # everything will eval to length 1 even if length > 1 because they are assigned to: # # function (x, value, pos = -1, envir = as.environment(pos), inherits = FALSE, immediate = TRUE) # .Internal(assign(x, value, envir, inherits)) # # Instead of being directly evaluated when building the macro, # this results (for a reason I haven't figured out yet) in only returning the # **first** object if something is given multiple assignment (ie a vector of # length > 1) # This is why the check "succeeds" in certain situations, because it silently avoids the length check # SO DON'T USE cmd_args_* WHEN BUILDING CHECKS (OR MACROS??) #requiredArgs <- cmd_args_all() %>% # cmd_list_drop_named("utils") requiredArgs <- list("environment_var" = environment_var, "option_name" = option_name, "default_path" = default_path) purrr::map(requiredArgs, length) %>% drop_list_fun(fun = function(x) x <= 1) %>% names %>% purrr::walk(~{ stop(paste0(.x, " must contain only 1 value")) }) # passing NULL to getOption returns NULL & throws error, # safely_ allows catching the NULL in .$result without throwing error safe_getOption <- purrr::safely(R.utils::getOption) return_valid_path <- function(path = NULL, util = NULL){ # Try to use correct path if user doesn't set in call pathList <- list() if (!is.null(path)) { pathList$user <- .check_valid_command_path(path) } if (!is.null(safe_getOption(option_name)$result)) { pathList$option <- valid_path_or_null(R.utils::getOption(option_name)) } if (!identical(Sys.getenv(environment_var), Sys.getenv()) & !identical(Sys.getenv(environment_var), "") & length(Sys.getenv(environment_var)) == 1) { pathList$environment <- valid_path_or_null(Sys.getenv(environment_var)) } if (!is.null(default_path)) { pathList$default <- default_path } if (length(pathList) == 0) stop("No path defined or detected") # use this vector to sort list of valid paths hierarchy <- c("user", "option", "environment", "default") validPathHierarchy <- pathList %>% unlist %>% sort_vector(hierarchy) %>% as.list() # This check is to mostly to evaluate default_path at runtime # if all other options fail. This is so that default_path values # like "~/path/to/file" won't expand at compile-time. fullPath <- .check_valid_command_path(validPathHierarchy[[1]]) if (!is.null(util)) { if (length(util) > 1){ stop("util must be NULL or length 1") } if (is.null(utils)){ stop("this function has no defined utils") } if (util == TRUE){ return(file.path(fullPath, utils)) } utilPath <- .check_valid_util(util, utils, fullPath) return(utilPath) } else { return(fullPath) } } return(return_valid_path) } #' Macro for constructing boolean check for valid path #' #' @param path_search function output of `cmd_path_search()` **NOTE:** When #' passing the function, do not pass as: `fun()`, but `fun` to avoid evaluation. #' @param util value to pass to `util` argument of `path_search`, allows #' building individual functions for each util (if passing one of each), #' or for simultaneously checking all utils if setting `util = TRUE`. Will #' cause error if `util = TRUE` but no utils are defined. **NOTE:** There is #' no error checking for whether `util` is set correctly during the build #' process, so ensure correct spelling, etc. to avoid cryptic failures. #' #' @return a function returning TRUE or FALSE if a valid install is detected. #' With arguments: `path` (a path to install location), `util` an optional `character(1)` to #' #' @export #' #' @examples #' if (.Platform$OS.type == "unix") { #' search <- cmd_path_search(option_name = "bin_path", default_path = "/bin/") #' valid_install <- cmd_install_is_valid(search) #' # Returns TRUE if "/bin/" exists #' valid_install() #' # Returns FALSE if "bad/path/" doesn't exist #' valid_install("bad/path/") #' #' # Also works with options #' search_option_only <- cmd_path_search(option_name = "bin_path") #' valid_install2 <- cmd_install_is_valid(search_option_only) #' options(bin_path = "/bin/") #' valid_install2() #' #' # Setting util = TRUE will check that all utils are also installed #' search_with_utils <- cmd_path_search(default_path = "/bin", utils = c("ls", "pwd")) #' valid_install_all <- cmd_install_is_valid(search_with_utils, util = TRUE) #' valid_install_all() #' } cmd_install_is_valid <- function(path_search, util = NULL){ util_check <- !is.null(util) util_true <- FALSE # This looks like bad code, but it's necessary since util can be `NULL`, # `logical(1)`, or a `character(1)`, so can't just use the value of util here. if (util_check){ if (util == TRUE){ util_true <- TRUE } } is_valid <- function(path = NULL){ x <- tryCatch(path_search(path = path, util = util), error = function(e) return(FALSE)) if (is.character(x) & !util_true){ return(TRUE) } if (util_true){ # util = TRUE will list all utils without checking # so have to check here return(all(file.exists(x))) } if (!x){ return(FALSE) } } return(is_valid) } #' Checks for valid members of subdirectory #' #' Not meant to be called directly #' #' @param util name of target located in path #' @param utils name of supported targets in path #' @param path path to directory #' #' @return safe path to util, or error if util does not exist #' @export #' #' @examples #' if (.Platform$OS.type == "unix") { #' # this will return /full/path/to/bin #' # or return an error for all values of util that are not "ls" and "pwd" #' # or error if "ls" does not exist in "/bin" #' .check_valid_util("ls", utils = c("ls", "pwd"), "/bin") #' #' \dontrun{ #' # This will throw error #' .check_valid_util("badUtil", utils = c("ls", "pwd"), "/bin") #' } #' } .check_valid_util <- function(util, utils = NULL, path = NULL){ testthat::expect_length(util, 1) # check util is valid needs_util_warning <- !util %in% utils # check util exists util_path <- file.path(sanitize_path(path), util) util_exists <- file.exists(util_path) if (!(needs_util_warning) & util_exists){ return(util_path) } if (!(needs_util_warning) & !(util_exists)){ stop(paste0(util_path, " is an invalid path to supported util: ", util, ". Check that ", util, " is installed.")) } if ((needs_util_warning) & !(util_exists)){ stop(paste0(util_path, " is an invalid path to an unsupported util: ", util)) } if (needs_util_warning & util_exists){ warning("the util: ", path, ", exists but is not supported by package maintainer or in `utils` definition") return(util_path) } } #' Checks path is valid #' #' Not meant to be called directly #' #' @param path path to file or directory #' #' @return expanded system path #' @export #' #' @examples #' if (.Platform$OS.type == "unix" & file.exists("~/bin")) { #' # will return /full/path/to/home/bin, or error if path doesn't exist #' .check_valid_command_path("~/bin") #' } .check_valid_command_path <- function(path){ path <- sanitize_path(path) command_exists <- file.exists(path) if (!command_exists){ stop(paste0("Command: ", path, ", does not exist.")) } return(path) } #' Check if path exists #' #' @param path file path #' #' @return boolean #' #' @noRd is_valid_path <- function(path){ path <- sanitize_path(path) is_valid <- file.exists(path) return(is_valid) } #' Checks if path exists #' #' @param path a path #' #' @return sanitized file path if it exists, otherwise return NULL #' #' @noRd valid_path_or_null <- function(path){ if (is_valid_path(path)){ return(sanitize_path(path)) } else { return(NULL) } } #' Sort a named vector using custom name order #' #' @param vector named vector #' @param names order to arrange names in vector #' #' @return sorted vector in order of names #' #' @noRd sort_vector <- function(vector, names){ vector[order(factor(names(vector), levels = names))] } cmdfun/NEWS.md0000644000176200001440000000237113735623502012635 0ustar liggesusers# cmdfun 1.0.2 * Vignette now directs users to cmdfun website: snystrom.github.io/cmdfun * Vignette alteration fixes bug where forcing vignette rebuild writes & cleans up empty dir to userspace if it doesn't exist to allow rebuild to complete without error * exports `cmd_list_keep_named` and `cmd_list_drop_named` which are less abstracted than `cmd_list_keep`/`cmd_list_drop` for the simple operation of dropping list items by name. # cmdfun 1.0.1 * Spell check fixes # cmdfun 1.0.0 * CRAN Release Candidate # cmdfun 0.2.01 * fixed error in .Rbuildignore causing failing R CMD CHECK # cmdfun 0.2.00 * Release candidate for CRAN submission # cmdfun 0.1.92.9000 * Updated README and `vignette("cmdfun")` to have more user-friendly explanations # cmdfun 0.1.91.9000 * Changed version numbering scheme to fix my terrible mistakes. This is what I get for implementing a versioning scheme just before bed. # cmdfun 0.1.10.9000 * Fixed `cmd_help_parse_flags()` so it now detects short (-) and long (--) flag names # cmdfun 0.1.9005 * Added a `NEWS.md` file to track changes to the package. * Renamed `cmd_help_parse_flags()` `processx` argument to `split_newline` * Updated maintainer email * Copied README text over to `cmdfun` vignette so pkg will have a vignette cmdfun/MD50000644000176200001440000000532213740277433012052 0ustar liggesusers4cb784e937c6d3d25baaac19583ca225 *DESCRIPTION 4372223e4f8ecceedafbae9d4b9cd59f *LICENSE 710ed15a6ba285566beb2fd09d03204e *NAMESPACE 3c9e1069e3230c5e250f18d528eabc2e *NEWS.md 9b4615c57d6dbd7035471d30a9fa49f7 *R/cmd_args.R de266f309be7376ccde075c11c18e4e0 *R/macros.R 1c49f50909310246758c8e73a5bc6c47 *R/parse_help.R 96ac987775c824fa89f523b96927e106 *R/utils.R 6ba0057507e6dd8f7c6af4823d094d1b *R/utils_internal.R 95f66fca1f5cfdf99b7cb075a51aeb88 *README.md 533053add2b30a806350370fbc07deb0 *build/vignette.rds 3c9e2d06e8560272e30c98b0c827478b *inst/doc/cmdfun.R 83d9b363fc172f47f7e14fcbe75d6a84 *inst/doc/cmdfun.Rmd 84e21b7c295e81d4da382f617d32e6d4 *inst/doc/cmdfun.html 320435cceed3a55e484efdf061fb7d36 *man/cmd_args_all.Rd 843da37a43b0db64ee983be83c863d0c *man/cmd_args_dots.Rd 9ca3cc15ddf0a176bb40588645ece0a1 *man/cmd_args_named.Rd e7478e62b95a9e8bb17ee68e5006f8c0 *man/cmd_error_if_missing.Rd 011ea9913c1bbb1bc145efa4f38c2345 *man/cmd_file_combn.Rd 6f819f489e85a2ef77f9eeffee593387 *man/cmd_file_expect.Rd 381790261582ffbcee045345f64267fc *man/cmd_help_flags_similar.Rd e1f8613099b32080f64dd7c4a6be183a *man/cmd_help_flags_suggest.Rd cf445b95eedf8cefc3f528ed2e696981 *man/cmd_help_parse_flags.Rd 9bb30956102ea52f8a2d09c0b8d6b500 *man/cmd_install_check.Rd ef34c73b21df883507580126632b1526 *man/cmd_install_is_valid.Rd 5ece37364e090dfc2437bcddb9a898c2 *man/cmd_list_drop.Rd fd638be550306198e6d08801c59a2465 *man/cmd_list_drop_named.Rd 27209c2031b0baba60fda1e599949f6a *man/cmd_list_interp.Rd 88b5f03d282a921c6d92eca5fb4a2e5f *man/cmd_list_keep.Rd 6c7220f0454b10f4d0ed2cc04523e570 *man/cmd_list_keep_named.Rd edaa08c211ea59b210b199191b7ae999 *man/cmd_list_to_flags.Rd 668f266148674e7972d18f7711ed2387 *man/cmd_path_search.Rd 472e8c30b3a10f24260a2b1e37c064f9 *man/cmd_ui_file_exists.Rd cefbaa79fbbc2c51536532f82e3f183c *man/dot-check_valid_command_path.Rd 475c24388e76099b7a9237b2173197a1 *man/dot-check_valid_util.Rd b413a2404ff7862d4a94314e14915ed4 *tests/testthat.R 9a2e5a62177fa604aa300072cc1ff38b *tests/testthat/helper-build_macro.R 64c9e81521eb49a23c232b22bcde5ecf *tests/testthat/helper-expect-outputs.R bd2e1bfcc2994a53eaccc9b2a388042d *tests/testthat/helper-file-exists.R 75481b64ceff1525f4e7cc63f3aae5c1 *tests/testthat/test_argsToFlags.R bc2e2571f686c541318670bbfdbace61 *tests/testthat/test_build_macro.R 0a58337bb9ac73e8a5fbb32dfa29536f *tests/testthat/test_expect-outputs.R 11e0d6b19b4908ecce7699d2184a3088 *tests/testthat/test_file-exists.R 64204106b48c2614e2ea4ed82f8c625a *tests/testthat/test_getArgs.R d41d8cd98f00b204e9800998ecf8427e *tests/testthat/test_internal.R 4ddec2e40d7cee2176fa9c50a532fd89 *tests/testthat/test_parse-help.R d0fa754c5d0b1a454bdadd1971bc8993 *tests/testthat/test_utils.R 83d9b363fc172f47f7e14fcbe75d6a84 *vignettes/cmdfun.Rmd cmdfun/inst/0000755000176200001440000000000013735633064012515 5ustar liggesuserscmdfun/inst/doc/0000755000176200001440000000000013735633064013262 5ustar liggesuserscmdfun/inst/doc/cmdfun.html0000644000176200001440000001035513735633064015430 0ustar liggesusers cmdfun

cmdfun

Please see the cmdfun website for full documentation:

In particular, a guide to building wrappers using cmdfun, complete with several examples, can be found here:

cmdfun/inst/doc/cmdfun.R0000644000176200001440000000021713735633064014661 0ustar liggesusers## ---- include = FALSE--------------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) cmdfun/inst/doc/cmdfun.Rmd0000644000176200001440000000103113735622423015172 0ustar liggesusers--- title: "cmdfun" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{cmdfun} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r, include = FALSE} knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ``` Please see the cmdfun website for full documentation: * In particular, a guide to building wrappers using cmdfun, complete with several examples, can be found here: *