fix: formatting when default is missing (#16)

* fix: formatting when default is missing

* fix: as.list generic signature

NAMESPACE

@@ -1,5 +1,6 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(as.list,options_env)
 S3method(conditionCall,options_error)
 S3method(define_option,character)
 S3method(define_option,option_spec)

R/options_env.R

@@ -115,11 +115,10 @@ get_options_spec <- function(env = parent.frame()) {
 #' @describeIn options_env
 #' Get single option specification
 get_option_spec <- function(
-  name,
-  env = parent.frame(),
-  inherits = FALSE,
-  on_missing = warning
-) {
+    name,
+    env = parent.frame(),
+    inherits = FALSE,
+    on_missing = warning) {
   optenv <- get_options_env(env, inherits = inherits)
   spec <- attr(optenv, "spec")
 
@@ -185,3 +184,16 @@ print.options_env <- function(x, ...) {
 
 #' @exportS3Method print options_list
 print.options_list <- print.options_env
+
+#' @exportS3Method as.list options_env
+as.list.options_env <- function(x, ...) {
+  values <- list()
+  for (n in names(x)) {
+    values[[n]] <- if (do.call(missing, list(n), envir = x)) {
+      bquote()
+    } else {
+      x[[n]]
+    }
+  }
+  values
+}

R/options_spec.R

@@ -101,17 +101,21 @@ option_spec <- function(
 ) {
   package <- pkgname(envir)
 
-  if (!missing(default) && !quoted && !eager)
+  if (!missing(default) && !quoted && !eager) {
     default <- match.call()[["default"]]
+  }
 
-  if (quoted && eager)
+  if (quoted && eager) {
     default <- eval(default, envir = envir)
+  }
 
-  if (is.function(option_name))
+  if (is.function(option_name)) {
     option_name <- option_name(package, name)
+  }
 
-  if (is.function(envvar_name))
+  if (is.function(envvar_name)) {
     envvar_name <- envvar_name(package, name)
+  }
 
   structure(
     list(
@@ -181,8 +185,8 @@ format.option_spec <- function(x, value, ..., fmt = options_fmts()) {
     # description
     "\n\n", sprintf("%s\n\n", fmt$desc(desc)),
     # defaults
-    " ", format_field("option",  src == "option",  fmt$optname(x$option_name), fmt), "\n",
-    " ", format_field("envvar",  src == "envir",   fmt$optname(x$envvar_name), fmt), envvar_help, "\n",
+    " ", format_field("option", src == "option", fmt$optname(x$option_name), fmt), "\n",
+    " ", format_field("envvar", src == "envvar", fmt$optname(x$envvar_name), fmt), envvar_help, "\n",
     " ", format_field("default", src == "default", deparse(x$expr), fmt),
     collapse = ""
   )
@@ -200,6 +204,7 @@ format.option_spec <- function(x, value, ..., fmt = options_fmts()) {
 #'
 #' @keywords internal
 format_field <- function(field, active, value, fmt = options_fmts()) {
+  active <- isTRUE(active)
   f <- if (active) fmt$field_active else fmt$field_inactive
   paste0(
     fmt$fade(if (active) "*" else " "),
@@ -219,18 +224,22 @@ format_field <- function(field, active, value, fmt = options_fmts()) {
 #'
 #' @keywords internal
 format_value <- function(x, ..., fmt = NULL) {
-  if (missing(x)) return("")
+  if (missing(x)) {
+    return("")
+  }
   UseMethod("format_value")
 }
 
 #' @method format_value default
 #' @name format_value
 format_value.default <- function(x, ..., fmt = options_fmts()) {
-  if (isS4(x))
+  if (isS4(x)) {
     UseMethod("format_value", structure(list(), class = "S4"))
+  }
 
-  if (!is.null(attr(x, "class")))
+  if (!is.null(attr(x, "class"))) {
     UseMethod("format_value", structure(list(), class = "S3"))
+  }
 
   str <- deparse(x)
   fmt$shorthand(paste0(
@@ -277,7 +286,11 @@ format_value.call <- function(x, ..., fmt = options_fmts()) {
 
 #' @name format_value
 format_value.name <- function(x, ..., fmt = options_fmts()) {
-  fmt$shorthand(paste0("`", as.character(x), "`"))
+  name <- as.character(x)
+  if (nchar(name) == 0) {
+    return(fmt$shorthand("<missing>"))
+  }
+  fmt$shorthand(paste0("`", name, "`"))
 }
 
 #' @name format_value

R/utils.R

@@ -16,11 +16,11 @@ pkgname <- function(env = parent.frame()) {
 
 `%||%` <- function(lhs, rhs) if (is.null(lhs)) rhs else lhs
 
-vlapply <- function(..., FUN.VALUE = logical(1L)) {  # nolint object_name_linter
+vlapply <- function(..., FUN.VALUE = logical(1L)) { # nolint object_name_linter
   vapply(..., FUN.VALUE = FUN.VALUE)
 }
 
-vcapply <- function(..., FUN.VALUE = character(1L)) {  # nolint object_name_linter
+vcapply <- function(..., FUN.VALUE = character(1L)) { # nolint object_name_linter
   vapply(..., FUN.VALUE = FUN.VALUE)
 }
 
@@ -55,9 +55,13 @@ raise <- function(x, ...) {
 #' @keywords internal
 raise.character <- function(x, ...) {
   x <- switch(x,
-    "print" = , "info" = , "message" = message,
-    "warn" = , "warning" = warning,
-    "error" = , "stop" = stop
+    "print" = ,
+    "info" = ,
+    "message" = message,
+    "warn" = ,
+    "warning" = warning,
+    "error" = ,
+    "stop" = stop
   )
 
   raise.function(x, ...)

tests/testthat/test-output.R

@@ -50,3 +50,10 @@ test_that("options objects prints options in definition order", {
   expect_silent(out <- paste0(capture.output(e$.options), collapse = "\n"))
   expect_match(out, "OPT_B.*OPT_A")
 })
+
+test_that("options objects print even without default", {
+  e <- new.env(parent = baseenv())
+  expect_silent(with(e, options::define_option("B")))
+  expect_silent(out <- paste0(capture.output(e$.options), collapse = "\n"))
+  expect_match(out, "<missing>")
+})