Refactor

DESCRIPTION

@@ -9,7 +9,7 @@ Description: Sometimes it is useful to serve up alternative 'shiny' UIs
     value of a cookie or a query parameter. This packages facilitates such
     switches.
 License: MIT + file LICENSE
-URL: https://shinyworks.github.io/scenes/,
+URL: https://scenes.shinyworks.org/scenes/,
     https://github.com/shinyworks/scenes
 BugReports: https://github.com/shinyworks/scenes/issues
 Imports: 
@@ -31,4 +31,4 @@ VignetteBuilder:
 Config/testthat/edition: 3
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.0

NAMESPACE

@@ -1,8 +1,5 @@
 # Generated by roxygen2: do not edit by hand
 
-S3method(.validate_character_scalar,"NULL")
-S3method(.validate_character_scalar,character)
-S3method(.validate_character_scalar,default)
 export(change_scene)
 export(construct_action)
 export(default_ui)
@@ -12,3 +9,4 @@ export(req_uses_get)
 export(req_uses_method)
 export(req_uses_post)
 export(set_scene)
+importFrom(rlang,"%||%")

R/action-cookie.R

@@ -1,12 +1,12 @@
 #' Switch Scenes on Cookies
 #'
-#' Create a `scene_action` specifying a cookie that must be present (or absent)
-#' and optionally a check function for that cookie.
+#' Create a [`scene_action`][scene_action-class] specifying a cookie that must
+#' be present (or absent) and optionally a check function for that cookie.
 #'
 #' @inheritParams .req_has_cookie_impl
 #' @inheritParams construct_action
 #'
-#' @return A `scene_action` object, to be used in [set_scene()].
+#' @return A [`scene_action`][scene_action-class], to be used in [set_scene()].
 #' @export
 #'
 #' @examples
@@ -25,28 +25,25 @@
 #'   }
 #' )
 #'
-#' # Specify an action to detect a cookie named "mycookie" that has N
-#' # characters. This would make more sense in a case where validation_fn isn't
-#' # an anonymous function.
+#' # Specify an action to detect a cookie named "mycookie" that has a
+#' # variable-defined number of characters.
+#' expect_n_chars <- function(x, N) {
+#'   nchar(x) == N
+#' }
+#' my_N <- 27 # Perhaps set by an environment variable.
 #' req_has_cookie(
 #'   cookie_name = "mycookie",
-#'   validation_fn = function(cookie_value, N) {
-#'     nchar(cookie_value) == N
-#'   },
-#'   N = 27
+#'   validation_fn = expect_n_chars,
+#'   N = my_N
 #' )
 req_has_cookie <- function(cookie_name,
                            validation_fn = NULL,
                            ...,
                            negate = FALSE) {
-  .validate_character_scalar(
-    parameter = cookie_name,
-    parameter_name = "cookie_name"
-  )
-
+  cookie_name <- .validate_character_scalar(cookie_name)
   return(
     construct_action(
-      fn = .req_has_cookie_impl,
+      .req_has_cookie_impl,
       cookie_name = cookie_name,
       validation_fn = validation_fn,
       ...,

R/action-method.R

@@ -1,38 +1,19 @@
 #' Switch Scenes on Method
 #'
-#' Create a `scene_action` specifying the HTTP method that must be used (or not
-#' used).
+#' Create a [`scene_action`][scene_action-class] specifying the HTTP method that
+#' must be used (or not used).
 #'
 #' @inheritParams .req_uses_method_impl
 #' @inheritParams construct_action
 #'
-#' @return A `scene_action` object, to be used in [set_scene()].
+#' @return A [`scene_action`][scene_action-class], to be used in [set_scene()].
 #' @export
 #'
 #' @examples
 #' req_uses_method("GET")
 #' req_uses_method("POST")
 req_uses_method <- function(method, negate = FALSE) {
-  valid_methods <- c(
-    "GET", "POST", "PUT",
-    "HEAD", "DELETE", "PATCH",
-    "OPTIONS", "CONNECT", "TRACE"
-  )
-
-  if (missing(method)) {
-    # I combine error messaging for the various 0-length cases, since toupper
-    # coerces.
-    method <- character(0)
-  }
-
-  method <- toupper(method)
-
-  .validate_character_scalar(
-    parameter = method,
-    parameter_name = "method",
-    valid_values = valid_methods
-  )
-
+  method <- .validate_methods(method, multiple = FALSE)
   return(
     construct_action(
       fn = .req_uses_method_impl,

R/action-query.R

@@ -1,16 +1,16 @@
 #' Switch Scenes on Query
 #'
-#' Create a `scene_action` specifying a key that must be present (or absent) in
-#' the query string (the part of the URL when the shiny app was called, after
-#' "?"), and optionally a value or values for that key. For example, in
-#' `myapps.shinyapps.io/myapp?param1=1&param2=text`, `?param1=1&param2=text` is
-#' the query string, `param1` and `param2` are keys, and `1` and `text` are
-#' their corresponding values.
+#' Create a [`scene_action`][scene_action-class] specifying a key that must be
+#' present (or absent) in the query string (the part of the URL when the shiny
+#' app was called, after "?"), and optionally a value or values for that key.
+#' For example, in `myapps.shinyapps.io/myapp?param1=1&param2=text`,
+#' `?param1=1&param2=text` is the query string, `param1` and `param2` are keys,
+#' and `1` and `text` are their corresponding values.
 #'
 #' @inheritParams .req_has_query_impl
 #' @inheritParams construct_action
 #'
-#' @return A `scene_action` object, to be used in [set_scene()].
+#' @return A [`scene_action`][scene_action-class], to be used in [set_scene()].
 #' @export
 #'
 #' @examples
@@ -26,11 +26,7 @@
 req_has_query <- function(key, values = NULL, negate = FALSE) {
   # I consciously decided NOT to vectorize this, because I think that would
   # complicate the call.
-  .validate_character_scalar(
-    parameter = key,
-    parameter_name = "key"
-  )
-
+  key <- .validate_character_scalar(key)
   return(
     construct_action(
       fn = .req_has_query_impl,

R/action.R

@@ -1,7 +1,7 @@
 #' Construct a Scene Action
 #'
 #' Generate the check function for an action, and use it to create a
-#' `scene_action` object.
+#' [`scene_action`][scene_action-class] object.
 #'
 #' @param fn A function that takes a request (and potentially other arguments)
 #'   and returns `TRUE` or `FALSE`.
@@ -11,7 +11,7 @@
 #' @param methods The http methods which needs to be accepted in order for this
 #'   function to make sense. Default "GET" should work in almost all cases.
 #'
-#' @return A `scene_action` object.
+#' @return A [`scene_action`][scene_action-class].
 #' @export
 #'
 #' @examples
@@ -26,41 +26,39 @@ construct_action <- function(fn,
                              ...,
                              negate = FALSE,
                              methods = "GET") {
+  methods <- .validate_methods(methods)
+  negate <- .validate_logical_scalar(negate)
+  check_fn <- .decorate_check_fn(fn, ..., negate = negate)
+  return(
+    .new_action(
+      check_fn = check_fn,
+      methods = methods
+    )
+  )
+}
+
+.validate_methods <- function(methods,
+                              multiple = TRUE,
+                              call = rlang::caller_env()) {
+  methods <- toupper(methods)
   rlang::arg_match(
     methods,
     c(
-      "GET",
-      "POST",
-      "PUT",
-      "HEAD",
-      "DELETE",
-      "PATCH",
-      "OPTIONS",
-      "CONNECT",
-      "TRACE"
+      "GET", "POST", "PUT", "HEAD", "DELETE",
+      "PATCH", "OPTIONS", "CONNECT", "TRACE"
     ),
-    multiple = TRUE
-  )
-  stopifnot(
-    is.logical(negate),
-    length(negate) == 1
+    multiple = multiple,
+    error_call = call
   )
+}
 
-  check_fn <- fn
-  if (...length()) {
-    check_fn <- purrr::partial({{ fn }}, ...)
-  }
+.decorate_check_fn <- function(fn, ..., negate) {
 
+  check_fn <- purrr::partial({{ fn }}, ...)
   if (negate) {
     check_fn <- Negate(check_fn)
   }
-
-  return(
-    .new_action(
-      check_fn = check_fn,
-      methods = methods
-    )
-  )
+  return(check_fn)
 }
 
 #' Structure a Scene Action
@@ -69,8 +67,7 @@ construct_action <- function(fn,
 #'   associated scene should be returned.
 #' @param methods The http methods supported by this action.
 #'
-#' @return A `scene_action` object, which is a `list` with components `check_fn`
-#'   and `methods`.
+#' @return A [`scene_action`][scene_action-class].
 #' @keywords internal
 .new_action <- function(check_fn, methods) {
   return(
@@ -83,3 +80,14 @@ construct_action <- function(fn,
     )
   )
 }
+
+#' `scene_action` class
+#'
+#' @description A `scene_action` object is a `list` with components `check_fn`
+#'   and `methods`. It is used to test whether a request should trigger a
+#'   particlar scene.
+#'
+#' @name scene_action-class
+#' @aliases scene_action
+#' @seealso [construct_action()]
+NULL