diff --git a/.Rbuildignore b/.Rbuildignore index d886236..e267aae 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -13,3 +13,4 @@ ^cran-comments\.md$ ^CRAN-SUBMISSION$ ^revdep$ +^\.git$ diff --git a/.Rprofile b/.Rprofile new file mode 100644 index 0000000..bdc5d4e --- /dev/null +++ b/.Rprofile @@ -0,0 +1,9 @@ + +.InstallScribe <- function() { + devtools::document() + pak::pkg_install("local::.", Sys.getenv("R_LIBS_SCRIBE")) +} + +if (file.exists("~/.Rprofile")) { + source("~/.Rprofile") +} diff --git a/.github/workflows/r-check-verison.yaml b/.github/workflows/r-check-verison.yaml index 44817de..398c002 100644 --- a/.github/workflows/r-check-verison.yaml +++ b/.github/workflows/r-check-verison.yaml @@ -18,7 +18,8 @@ jobs: - uses: r-lib/actions/setup-r-dependencies@v2 with: - extra-packages: any::gh, any::fuj + packages: any::gh, any::fuj + pandoc-install: false - uses: jmbarbone/actions/r-check-version@main with: diff --git a/.github/workflows/r-check-version.yaml b/.github/workflows/r-check-version.yaml deleted file mode 100644 index 44817de..0000000 --- a/.github/workflows/r-check-version.yaml +++ /dev/null @@ -1,25 +0,0 @@ -on: - pull_request: - branches: [main, master] - -name: version checks - -jobs: - check-r-version: - runs-on: ubuntu-latest - env: - GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} - steps: - - uses: actions/checkout@v3 - - - uses: r-lib/actions/setup-r@v2 - with: - use-public-rspm: true - - - uses: r-lib/actions/setup-r-dependencies@v2 - with: - extra-packages: any::gh, any::fuj - - - uses: jmbarbone/actions/r-check-version@main - with: - ignore-dev-version: true diff --git a/DESCRIPTION b/DESCRIPTION index ece63c5..17e1641 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: scribe Title: Command Argument Parsing -Version: 0.3.0.9001 +Version: 0.3.0.9002 Authors@R: person( given = "Jordan Mark", @@ -16,7 +16,7 @@ License: MIT + file LICENSE Encoding: UTF-8 Language: en-US Roxygen: list(markdown = TRUE) -RoxygenNote: 7.3.0 +RoxygenNote: 7.3.1 Depends: R (>= 3.6) Imports: diff --git a/NEWS.md b/NEWS.md index c247dd8..2ffaa85 100644 --- a/NEWS.md +++ b/NEWS.md @@ -15,6 +15,8 @@ These are not meant to be user accessible. - `new_arg()` now throws a more helpful error when _value doesn't convert to itself_ - `arg$show()` now denotes if the argument is resolves by display an `"R"` before the value - `arg$show()` now prints values of class `"scribe_empty_value"` as `` +- `arg$add_argument()` correctly passes all method arguments [#78](https://github.com/jmbarbone/scribe/issues/78) +- `ca$parse()` correctly deals with new arguments that nave the same _name_ as ones in `included` [#80](https://github.com/jmbarbone/scribe/issues/80) # scribe 0.3.0 diff --git a/R/class-command-args.R b/R/class-command-args.R index 978013c..a3da5d2 100644 --- a/R/class-command-args.R +++ b/R/class-command-args.R @@ -205,12 +205,13 @@ scribeCommandArgs$methods( add_argument = function( ..., - action = arg_actions(), - options = NULL, - convert = scribe_convert(), + action = arg_actions(), default = NULL, - n = NA_integer_, - info = NULL, + convert = scribe_convert(), + n = NA_integer_, + info = NULL, + options = list(), + stop = c("none", "hard", "soft"), execute = invisible ) { "Add a \\link{scribeArg} to \\code{args} @@ -220,17 +221,20 @@ scribeCommandArgs$methods( all other arguments are ignored. Note that only the first value (\\link{..1}) is used.} \\item{\\code{action}, \\code{options}, \\code{convet}, \\code{default}, - \\code{n}, \\code{info}}{See \\code{\\link[=new_arg]{new_arg()}}} + \\code{n}, \\code{info}, \\code{stop}, \\code{execute}}{See + \\code{\\link[=new_arg]{new_arg()}}} }" ca_add_argument( self = .self, ..., action = action, - options = options, - convert = convert, default = default, + convert = convert, n = n, - info = info + info = info, + options = options, + stop = stop, + execute = execute ) }, diff --git a/R/command-args.R b/R/command-args.R index c9b136e..abf829c 100644 --- a/R/command-args.R +++ b/R/command-args.R @@ -47,7 +47,7 @@ command_args <- function( ca_initialize <- function( self, - input = NULL, + input = "", include = c("help", "version", NA_character_), supers = include ) { @@ -97,7 +97,7 @@ ca_initialize <- function( invisible(self) } -ca_show <- function(self, all_values = FALSE, ...) { +ca_show <- function(self, ...) { print_line("Initial call: ", to_string(self$get_input())) if (!self$resolved) { @@ -203,28 +203,28 @@ ca_resolve <- function(self) { # dots must always be parsed last wapply(args, function(i) i$positional), wapply(args, function(i) i$action == "dots"), - wapply(args, function(i) inherits(i, "scribeSuperArg")) + NULL ), fromLast = TRUE ) # move stops earlier arg_order <- unique(c( + wapply(args, function(i) inherits(i, "scribeSuperArg")), wapply(args, function(i) i$stop == "hard"), wapply(args, function(i) i$stop == "soft"), arg_order )) - arg_names <- vapply(args, function(arg) arg$get_name(), NA_character_) - self$field("values", structure( - vector("list", length(arg_order)), - names = arg_names[arg_order] - )) - for (arg in args[arg_order]) { - self$set_values(arg$get_name(), arg_parse_value(arg, self)) + arg_parse_value(arg, self) } + self$field("values", structure( + lapply(args, function(arg) arg$get_value()), + names = vapply(args, function(arg) arg$get_name(), NA_character_) + )) + if (length(ca_get_working(self)) && self$stop == "none") { warning( "Not all values parsed:\n", @@ -233,7 +233,6 @@ ca_resolve <- function(self) { ) } - self$field("values", self$values[order(arg_order)]) self$field("resolved", TRUE) invisible(self) } @@ -272,7 +271,14 @@ ca_get_values <- function( values <- self$values if (!included) { - values <- values[setdiff(names(values), self$included)] + # in the event that an arg uses a name like 'version', this will only remove + # the first instance -- which should be the 'included' args. Should + # probably be searching by class instead. + m <- match(self$included, names(values), 0L) + ok <- which(m > 0L) + if (length(ok)) { + values <- values[-m[ok]] + } } if (!super && !is.null(names(values))) { @@ -286,11 +292,11 @@ ca_get_values <- function( values } -ca_set_values <- function(self, i = NULL, value) { +ca_set_values <- function(self, i = TRUE, value) { stopifnot(length(i) == 1) if (is.null(value)) { - return(NULL) + return(invisible(self)) } self$field("values", replace2(self$values, i, value)) @@ -316,13 +322,13 @@ ca_get_args <- function(self, included = TRUE, super = FALSE) { ca_add_argument <- function( self, ..., - n = NA_integer_, - action = NULL, - convert = scribe_convert(), - options = NULL, + action = arg_actions(), default = NULL, - info = NULL, - stop = "none", + convert = scribe_convert(), + n = NA_integer_, + info = NULL, + options = list(), + stop = c("none", "hard", "soft"), execute = invisible ) { if (is_arg(..1)) { @@ -343,13 +349,13 @@ ca_add_argument <- function( arg <- new_arg( aliases = aliases, - action = action, - options = options, - convert = convert, + action = action, default = default, - info = info, - stop = stop, - n = as.integer(n), + convert = convert, + n = as.integer(n), + info = info, + options = options, + stop = stop, execute = execute ) } @@ -391,7 +397,7 @@ ca_set_example <- function(self, x = character(), comment = "", prefix = "$ ") { invisible(self) } -ca_add_example <- function(self, x = NULL, comment = "", prefix = "$ ") { +ca_add_example <- function(self, x, comment = "", prefix = "$ ") { if (is.null(x)) { return(invisible(self)) } diff --git a/R/convert.R b/R/convert.R index 67e59c5..305d7f9 100644 --- a/R/convert.R +++ b/R/convert.R @@ -71,7 +71,12 @@ scribe_convert <- function(method = c("default", "evaluate", "none")) { method, none = identity, default = value_convert, - evaluate = function(x, ...) eval(str2expression(as.character(x)), baseenv()) + evaluate = function(x, ...) { + if (!is.character(x)) { + return(x) + } + eval(str2expression(as.character(x)), baseenv()) + } ) } diff --git a/R/utils-testthat.R b/R/utils-testthat.R new file mode 100644 index 0000000..af58004 --- /dev/null +++ b/R/utils-testthat.R @@ -0,0 +1,44 @@ +#' Check method arguments +#' +#' @param object Object to check +#' @param prefix Prefix to use for method names +#' @param verbose Print out additional information +#' @keywords internal +#' @noRd +check_methods <- function(object, prefix, verbose = getOption("verbose")) { + requireNamespace("testthat") + + for (method in object$methods()) { + obj <- get0(method, object$def@refMethods, mode = "function") + + if (is.null(obj)) { + next + } + + exp <- get0(paste0(prefix, method), mode = "function") + + if (is.null(exp)) { + if (verbose) { + cat("Skipping method: ", method, "()\n", sep = "") # nocov + } + + next + } + + obj <- as.list(formals(obj)) + + if (identical(obj, list())) { + # exp will be a named list, but will be empty + obj <- structure(list(), names = character()) + } + + exp <- as.list(formals(exp))[-1L] + + testthat::expect_identical( + object = obj, + expected = exp, + info = paste0("method: ", method, "()"), + ignore_srcref = TRUE + ) + } +} diff --git a/inst/WORDLIST b/inst/WORDLIST index 9299045..aa0b02f 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -1,13 +1,12 @@ CMD Codecov -fixmes ORCID +ReferenceClass +Rscript +arg +args +fixmes pak pkgs -ReferenceClass repo -Rscript -scribeArg -scribeArgs -scribeCommandArgs todos diff --git a/man/scribeCommandArgs-class.Rd b/man/scribeCommandArgs-class.Rd index 7901b0a..b4dae88 100644 --- a/man/scribeCommandArgs-class.Rd +++ b/man/scribeCommandArgs-class.Rd @@ -75,11 +75,12 @@ track parsing progress and is not meant to be accessed directly.} \item{\code{add_argument( ..., action = arg_actions(), - options = NULL, - convert = scribe_convert(), default = NULL, + convert = scribe_convert(), n = NA_integer_, info = NULL, + options = list(), + stop = c("none", "hard", "soft"), execute = invisible )}}{Add a \link{scribeArg} to \code{args} @@ -88,7 +89,8 @@ track parsing progress and is not meant to be accessed directly.} all other arguments are ignored. Note that only the first value (\link{..1}) is used.} \item{\code{action}, \code{options}, \code{convet}, \code{default}, - \code{n}, \code{info}}{See \code{\link[=new_arg]{new_arg()}}} + \code{n}, \code{info}, \code{stop}, \code{execute}}{See + \code{\link[=new_arg]{new_arg()}}} }} \item{\code{add_description(..., sep = "")}}{Add a value to \code{description} diff --git a/tests/testthat/_snaps/class-command-args.md b/tests/testthat/_snaps/class-command-args.md index eea3eee..b1d69d0 100644 --- a/tests/testthat/_snaps/class-command-args.md +++ b/tests/testthat/_snaps/class-command-args.md @@ -194,7 +194,7 @@ Code command_args("---help")$parse() Output - {scribe} v0.3.0.9001 + {scribe} v0.3.0.9002 For more information, see https://jmbarbone.github.io/scribe/ named list() @@ -203,6 +203,6 @@ Code command_args("---version")$parse() Output - 0.3.0.9001 + 0.3.0.9002 named list() diff --git a/tests/testthat/scripts/help.R b/tests/testthat/scripts/help.R index 0fc98ef..21b8160 100755 --- a/tests/testthat/scripts/help.R +++ b/tests/testthat/scripts/help.R @@ -1,6 +1,13 @@ #!/usr/bin/Rscript --vanilla -library(scribe) +if (!require( + scribe, + lib.loc = Sys.getenv("R_LIBS_SCRIBE", "~/R/scribe-library") +)) { + warning("expected {scribe} to be installed at R_LIBS_SCRIBE") + library(scribe) +} + ca <- command_args() ca$add_argument("-f", "--foo") ca$add_argument("-b", "--bar") diff --git a/tests/testthat/test-class-args.R b/tests/testthat/test-class-args.R index afba539..11d30c1 100644 --- a/tests/testthat/test-class-args.R +++ b/tests/testthat/test-class-args.R @@ -19,6 +19,12 @@ test_that("errors", { expect_warning(expect_warning(ca$parse())) }) +test_that("method arguments are correct", { + check_methods(scribeArg, "arg_") +}) + +# regressions ------------------------------------------------------------- + test_that("$get_names() [#10]", { x <- new_arg("-f", n = 1L) expect_identical(x$get_name(), "f") diff --git a/tests/testthat/test-class-command-args.R b/tests/testthat/test-class-command-args.R index 143550f..07d073f 100644 --- a/tests/testthat/test-class-command-args.R +++ b/tests/testthat/test-class-command-args.R @@ -221,14 +221,20 @@ test_that("default values", { ca$add_argument("two", default = 0) ca$add_argument("three", default = 0) ca$add_argument("four", default = 0L) + ca$add_argument("five", default = 0) obj <- ca$parse() exp <- list( one = 1L, two = 2, three = 3, - four = 4L + four = 4L, + five = 0 ) expect_identical(obj, exp) + + ca <- command_args() + ca$add_argument("foo", default = 0) + expect_identical(ca$parse(), list(foo = 0)) }) test_that("$get_args(included)", { @@ -245,6 +251,16 @@ test_that("$get_args(included)", { expect_identical(obj, exp) }) +test_that("'version' (or other inluced) can be set [#90]", { + ca <- command_args(1L) + ca$add_argument("version") + expect_identical(ca$parse(), list(version = 1L)) + + ca <- command_args() + ca$add_argument("help", default = "me") + expect_identical(ca$parse(), list(help = "me")) +}) + test_that("positional values [#22]", { ca <- command_args(1:2) ca$add_argument("foo", default = 0) @@ -381,6 +397,23 @@ test_that("versions", { expect_output(ca$version()) }) +test_that("$set_values()", { + # updates no longer use ca$set_values(); so maybe this gets deprecated + ca <- command_args() + ca$add_argument("foo") + expect_identical(ca$parse(), list(foo = NULL)) + + ca$set_values("foo", TRUE) + ca$set_values("foo", NULL) + expect_identical(ca$parse(), list(foo = TRUE)) +}) + +test_that("method arguments are correct", { + check_methods(scribeCommandArgs, "ca_") +}) + +# regressions ------------------------------------------------------------- + test_that("positional defaults [#52]", { ca <- command_args() ca$add_argument("pos", default = 1) @@ -445,6 +478,8 @@ test_that("'convert' isn't ignored [#70]", { expect_error(ca$parse(), "success") }) +# snapshots --------------------------------------------------------------- + test_that("snapshots", { ca <- command_args(string = "foo bar --fizz") ca$add_description("this does a thing") diff --git a/tests/testthat/test-convert.R b/tests/testthat/test-convert.R index 0c57614..970ce9d 100644 --- a/tests/testthat/test-convert.R +++ b/tests/testthat/test-convert.R @@ -61,6 +61,16 @@ test_that("scribe_convert()", { expect_type(scribe_convert("eval"), "closure") expect_type(scribe_convert(function(x) x), "closure") + + e <- scribe_convert("evaluate") + expect_identical(e("TRUE"), TRUE) + expect_identical(e("TRUE"), e(TRUE)) + expect_identical(e("1.1"), 1.1) + expect_identical(e("1.1"), e(1.1)) + expect_identical(e("1"), 1) + expect_identical(e("1"), e(1)) + expect_identical(e("1L"), 1L) + expect_identical(e("1L"), e(1L)) }) test_that("command_arg() default conversions", { @@ -118,3 +128,18 @@ test_that("command_arg() custom", { test_that("default_convert(character()) [#5]", { expect_identical(default_convert(character()), character()) }) + +test_that("scribe_convert('evaluate') with defaults", { + ca <- command_args(include = NA) + ca$add_argument("foo", default = 1L, convert = scribe_convert("evaluate")) + expect_identical(ca$parse(), list(foo = 1L)) + + ca$set_input("2") + expect_identical(ca$parse(), list(foo = 2)) + + ca$set_input("3L") + expect_identical(ca$parse(), list(foo = 3L)) + + ca$set_input("1:4") + expect_identical(ca$parse(), list(foo = 1:4)) +})