Merge 504dc67 into f75ce74

DESCRIPTION

@@ -21,6 +21,7 @@ Imports:
     checkmate,
     ggplot2,
     graphics,
+    grDevices,
     htmltools,
     lifecycle,
     methods,

NEWS.md

@@ -1,5 +1,10 @@
 # teal.widgets 0.4.0.9001
 
+### Miscellaneous
+
+* Documentation enhancements - code formatting package names and R objects.
+* Add `grDevices` to Imports.
+
 # teal.widgets 0.4.0
 
 ### Bug fixes

R/basic_table_args.R

@@ -46,7 +46,7 @@ basic_table_args <- function(...) {
 #'  module creator setup for [rtables::basic_table()] of a specific table.
 #'  Created with the [basic_table_args()] function. The `NULL` value is supported.
 #' @param app_default (`basic_table_args`)\cr
-#'  teal option variable. The `NULL` value is supported.
+#'  Application level setting. Can be `NULL`.
 #'
 #' @return `basic_table_args` object.
 #' @details

R/ggplot2_args.R

@@ -61,7 +61,7 @@ ggplot2_args <- function(labs = list(), theme = list()) {
 #'  module creator setup for theme and labs in the specific plot.
 #'  Created with the [ggplot2_args()] function. The `NULL` value is supported.
 #' @param app_default (`ggplot2_args`)\cr
-#'  teal option variable. The `NULL` value is supported.
+#'  Application level setting. Can be `NULL`.
 #'
 #' @return `ggplot2_args` object.
 #'

R/optionalInput.R

@@ -421,12 +421,12 @@ optionalSliderInput <- function(inputId, label, min, max, value, label_help = NU
   }
 }
 
-#' For teal modules we parameterize an \code{optionalSliderInput} with one argument
+#' For `teal` modules we parameterize an \code{optionalSliderInput} with one argument
 #' \code{value_min_max}
 #'
 #' @description `r lifecycle::badge("stable")`
-#' The [optionalSliderInput()] function needs three arguments to decided
-#' whether to hide the `sliderInput` widget or not. For teal modules we specify an
+#' The [optionalSliderInput()] function needs three arguments to determine
+#' whether to hide the `sliderInput` widget or not. For `teal` modules we specify an
 #' optional slider input with one argument here called `value_min_max`.
 #'
 #' @inheritParams optionalSliderInput
@@ -443,20 +443,26 @@ optionalSliderInput <- function(inputId, label, min, max, value, label_help = NU
 #' optionalSliderInputValMinMax("a", "b", 1)
 #' optionalSliderInputValMinMax("a", "b", c(3, 1, 5))
 optionalSliderInputValMinMax <- function(inputId, label, value_min_max, label_help = NULL, ...) { # nolint
+  checkmate::assert(
+    checkmate::check_numeric(
+      value_min_max,
+      finite = TRUE,
+      len = 3
+    ),
+    checkmate::check_numeric(
+      value_min_max,
+      finite = TRUE,
+      len = 1
+    )
+  )
 
   x <- value_min_max
 
-  if (!is.numeric(x)) stop("value_min_max is expected to be numeric")
-
   vals <- if (length(x) == 3) {
-    if (any(diff(x[c(2, 1, 3)]) < 0)) {
-      stop(paste("value_min_max is expected to be (value, min, max) where min <= value <= max"))
-    }
+    checkmate::assert_number(x[1], lower = x[2], upper = x[3], .var.name = "value_min_max")
     list(value = x[1], min = x[2], max = x[3])
   } else if (length(x) == 1) {
     list(value = x, min = NA_real_, max = NA_real_)
-  } else {
-    stop(paste("value_min_max is expected to be of length 1 (value) or of length 3 (value, min, max)"))
   }
 
   slider <- optionalSliderInput(inputId, label, vals$min, vals$max, vals$value, ...)

R/standard_layout.R

@@ -2,7 +2,7 @@
 #' the left
 #'
 #' @description `r lifecycle::badge("stable")`
-#' This is the layout used for the teal modules in the `beam` package
+#' This is the layout used by the `teal` modules.
 #'
 #' @param output (`shiny.tag`)\cr
 #'   object with the output element (table, plot, listing) such as for example returned
@@ -26,18 +26,10 @@ standard_layout <- function(output,
                             pre_output = NULL,
                             post_output = NULL) {
   # checking arguments
-  if (!inherits(output, c("shiny.tag", "shiny.tag.list", "html"))) {
-    stop("output is supposed to be of class shiny.tag or shiny.tag.list")
-  }
-  for (name in names(l <- list(
-    "encoding" = encoding,
-    "pre_output" = pre_output,
-    "post_output" = post_output
-  ))) {
-    if (!is.null(l[[name]]) && !inherits(l[[name]], c("shiny.tag", "shiny.tag.list", "html"))) {
-      stop(paste(name, "is supposed to be NULL, shiny.tag or shiny.tag.list."))
-    }
-  }
+  checkmate::assert_multi_class(output, c("shiny.tag", "shiny.tag.list", "html"))
+  checkmate::assert_multi_class(encoding, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE)
+  checkmate::assert_multi_class(pre_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE)
+  checkmate::assert_multi_class(post_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE)
 
   # if encoding=NULL then forms is placed below output
 

R/teal.widgets-package.R

@@ -1,7 +1,7 @@
-#' teal.widgets: Custom widgets for teal applications
+#' `teal.widgets`: Custom widgets for `teal` applications
 #'
 #' The `teal.widgets` package contains functionalities that can be used
-#' for teal module development. The Package is dedicated to allow developers to extend modules
+#' for `teal` module development. The package is dedicated to allow developers to extend module
 #' functionality by additional inputs and output controls.
 #'
 #' @keywords internal

R/verbatim_popup.R

@@ -30,8 +30,7 @@ verbatim_popup_ui <- function(id, button_label, type = c("button", "link"), ...)
 
   ui_function <- switch(match.arg(type),
     "button" = shiny::actionButton,
-    "link" = shiny::actionLink,
-    stop("Argument 'type' should be 'button' or 'link'")
+    "link" = shiny::actionLink
   )
 
   ns <- shiny::NS(id)

tests/testthat/helpers-with-settings.R

@@ -86,11 +86,11 @@ app_pws <- function() {
 #' @keywords internal
 is_draw <- function(plot_fun) {
   checkmate::assert_function(plot_fun)
-  graphics.off() # close any current graphics devices
-  cdev <- dev.cur()
+  grDevices::graphics.off() # close any current graphics devices
+  cdev <- grDevices::dev.cur()
   plot_fun()
-  if (cdev != dev.cur()) {
-    on.exit(dev.off())
+  if (cdev != grDevices::dev.cur()) {
+    on.exit(grDevices::dev.off())
     return(TRUE)
   }
   return(FALSE)

tests/testthat/test-plot_with_settings_ui.R

@@ -1,8 +1,8 @@
-testthat::test_that("type_download_ui returns shiny.tag", {
+testthat::test_that("type_download_ui returns `shiny.tag`", {
   testthat::expect_s3_class(type_download_ui("STH"), "shiny.tag")
 })
 
-testthat::test_that("plot_with_settings_ui returns shiny.tag.list", {
+testthat::test_that("plot_with_settings_ui returns `shiny.tag.list`", {
   testthat::expect_s3_class(plot_with_settings_ui("STH"), "shiny.tag.list")
 })
 

tests/testthat/test-standard_layout.R

@@ -4,25 +4,28 @@ testthat::test_that("Input validation", {
 
   testthat::expect_error(
     standard_layout(NULL),
-    regexp = "output is supposed to be of class shiny.tag or shiny.tag.list"
+    regexp = "Assertion on 'output' failed"
   )
 
-  testthat::expect_error(standard_layout(1), regexp = "output is supposed to be of class shiny.tag or shiny.tag.list")
+  testthat::expect_error(
+    standard_layout(1),
+    regexp = "Assertion on 'output' failed"
+  )
 
   testthat::expect_error(standard_layout(
     output = tags$div(),
     encoding = 1
-  ), regexp = "encoding is supposed to be NULL, shiny.tag or shiny.tag.list.")
+  ), regexp = "Assertion on 'encoding' failed")
 
   testthat::expect_error(standard_layout(
     output = tags$div(),
     pre_output = 1
-  ), regexp = "pre_output is supposed to be NULL, shiny.tag or shiny.tag.list.")
+  ), regexp = "Assertion on 'pre_output' failed")
 
   testthat::expect_error(standard_layout(
     output = tags$div(),
     post_output = 1
-  ), regexp = "post_output is supposed to be NULL, shiny.tag or shiny.tag.list.")
+  ), regexp = "Assertion on 'post_output' failed")
 })
 
 # Result ----