Merge pull request #79 from jmbarbone/78-scribe-execute

78 scribe execute

.Rbuildignore

@@ -13,3 +13,4 @@
 ^cran-comments\.md$
 ^CRAN-SUBMISSION$
 ^revdep$
+^\.git$

.Rprofile

@@ -0,0 +1,9 @@
+
+.InstallScribe <- function() {
+  devtools::document()
+  pak::pkg_install("local::.", Sys.getenv("R_LIBS_SCRIBE"))
+}
+
+if (file.exists("~/.Rprofile")) {
+  source("~/.Rprofile")
+}

.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:

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:

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 `<empty>`
+- `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
 

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
     )
   },
 

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))
   }

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())
+    }
   )
 }
 

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
+    )
+  }
+}

inst/WORDLIST

@@ -1,13 +1,12 @@
 CMD
 Codecov
-fixmes
 ORCID
+ReferenceClass
+Rscript
+arg
+args
+fixmes
 pak
 pkgs
-ReferenceClass
 repo
-Rscript
-scribeArg
-scribeArgs
-scribeCommandArgs
 todos

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()
 

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")