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