Make R6 apis consistent

DESCRIPTION

@@ -52,26 +52,28 @@ Collate:
     'async.R'
     'content-types.R'
     'default-handlers.R'
+    'shared-secret-filter.R'
+    'parser-cookie.R'
+    'parse-body.R'
+    'parse-query.R'
+    'plumber.R'
+    'deprecated-R6.R'
     'deprecated.R'
     'digital-ocean.R'
     'find-port.R'
     'globals.R'
+    'hookable.R'
     'includes.R'
     'json.R'
     'new-rstudio-project.R'
     'openapi-spec.R'
     'openapi-types.R'
-    'parse-body.R'
-    'parse-query.R'
-    'parser-cookie.R'
     'paths.R'
     'plumb-block.R'
     'plumb-globals.R'
     'plumb.R'
     'plumber-options.R'
     'plumber-response.R'
-    'shared-secret-filter.R'
-    'plumber.R'
     'plumber-static.R'
     'plumber-step.R'
     'pr.R'

NAMESPACE

@@ -3,6 +3,7 @@
 S3method(format,plumber_available_apis)
 S3method(print,plumber_available_apis)
 export("%>%")
+export(Plumber)
 export(PlumberEndpoint)
 export(PlumberStatic)
 export(addSerializer)

NEWS.md

@@ -20,7 +20,7 @@ plumber 1.0.0
 
 ### Breaking changes
 
-* When `plumb()`ing a file (or `plumber$new(file)`), the working directory is set to the file's directory before parsing the file. When running the Plumber API, the working directory will be set to file's directory before running.(#631)
+* When `plumb()`ing a file (or `Plumber$new(file)`), the working directory is set to the file's directory before parsing the file. When running the Plumber API, the working directory will be set to file's directory before running.(#631)
 
 * Plumber's OpenAPI Specification is now defined using
   [OpenAPI 3](https://github.com/OAI/OpenAPI-Specification/blob/master/versions/3.0.3.md),

R/deprecated-R6.R

@@ -0,0 +1,51 @@
+#' @include plumber.R
+NULL
+
+#' Deprecated R6 functions
+#'
+#' @keywords internal
+#' @describeIn deprecated_r6 See [Hookable()]
+hookable <- R6Class(
+  "hookable",
+  inherit = Hookable,
+  public = list(
+    #' @description Initialize a new `hookable`. Throws deprecated warning prompting user to use [`Hookable`]
+    initialize = function() {
+      # use `.Deprecated` until `lifecycle` gets R6 support
+      .Deprecated(msg = paste0(
+        "`hookable` is deprecated as of plumber 1.0.0.\n",
+        "Please use `Hookable` instead."
+      ))
+      # lifecycle::deprecate_warn("1.0.0", "hookable$new()", "Hookable$new()")
+
+
+      ## no initialize method
+      # super$initialize()
+    }
+  )
+)
+
+
+#' Deprecated R6 functions
+#'
+#' @keywords internal
+#' @export
+#' @describeIn deprecated_r6 See [Plumber()]
+plumber <- R6Class(
+  "plumber",
+  inherit = Plumber,
+  public = list(
+    #' @description Initialize a new `plumber`. Throws deprecated warning prompting user to use [`Plumber`]
+    #' @param ... params passed in to `Plumber$new()`
+    initialize = function(...) {
+      # use `.Deprecated` until `lifecycle` gets R6 support
+      .Deprecated(msg = paste0(
+        "`plumber` is deprecated as of plumber 1.0.0.\n",
+        "Please use `Plumber` instead."
+      ))
+      # lifecycle::deprecate_warn("1.0.0", "hookable$new()", "Hookable$new()")
+
+      super$initialize(...)
+    }
+  )
+)

R/hookable.R

@@ -0,0 +1,77 @@
+#' @keywords internal
+#' @title Hookable
+Hookable <- R6Class(
+  "Hookable",
+  public=list(
+    #' @description Register a hook on a router
+    #' @param stage a character string.
+    #' @param handler a hook function.
+    registerHook = function(stage, handler){
+      private$hooks[[stage]] <- c(private$hooks[[stage]], handler)
+    },
+    #' @description Register hooks on a router
+    #' @param handlers a named list of hook functions.
+    registerHooks = function(handlers){
+      for (i in 1:length(handlers)){
+        stage <- names(handlers)[i]
+        h <- handlers[[i]]
+
+        self$registerHook(stage, h)
+      }
+    }
+  ), private=list(
+    hooks = list( ),
+
+    # Because we're passing in a `value` argument here, `runHooks` will return either the
+    # unmodified `value` argument back, or will allow one or more hooks to modify the value,
+    # in which case the modified value will be returned. Hooks declare that they intend to
+    # modify the value by accepting a parameter named `value`, in which case their returned
+    # value will be used as the updated value.
+    runHooks = function(stage, args) {
+      if (missing(args)) {
+        args <- list()
+      }
+
+      stageHooks <- private$hooks[[stage]]
+      if (length(stageHooks) == 0) {
+        # if there is nothing to execute, return early
+        return(args$value)
+      }
+
+      runSteps(
+        NULL,
+        errorHandlerStep = stop,
+        append(
+          unlist(lapply(stageHooks, function(stageHook) {
+            stageHookArgs <- list()
+            list(
+              function(...) {
+                stageHookArgs <<- getRelevantArgs(args, plumberExpression = stageHook)
+              },
+              function(...) {
+                do.call(stageHook, stageHookArgs) #TODO: envir=private$envir?
+              },
+              # `do.call` could return a promise. Wait for it's return value
+              # if "value" exists in the original args, overwrite it for futher execution
+              function(value, ...) {
+                if ("value" %in% names(stageHookArgs)) {
+                  # Special case, retain the returned value from the hook
+                  # and pass it in as the value for the next handler.
+                  # Ultimately, return value from this function
+                  args$value <<- value
+                }
+                NULL
+              }
+            )
+          })),
+          list(
+            function(...) {
+              # Return the value as passed in or as explcitly modified by one or more hooks.
+              return(args$value)
+            }
+          )
+        )
+      )
+    }
+  )
+)

R/parse-body.R

@@ -334,7 +334,7 @@ make_parser <- function(aliases) {
 #' # Activate `rds` parser in a multipart request
 #' #* @parser multi
 #' #* @parser rds
-#' pr <- plumber$new()
+#' pr <- Plumber$new()
 #' pr$handle("GET", "/upload", function(rds) {rds}, parsers = c("multi", "rds"))
 #' }
 #' @export

R/plumb.R

@@ -49,7 +49,7 @@ plumb <- function(file = NULL, dir = ".") {
       #   sourceUTF8 returns the (visible) value object. No need to call source()$value()
       pr <- sourceUTF8(entrypoint, new.env(parent = globalenv()))
 
-      if (!inherits(pr, "plumber")){
+      if (!is_pr(pr)) {
         stop("'", entrypoint, "' must return a runnable Plumber router.")
       }
 
@@ -75,7 +75,7 @@ plumb <- function(file = NULL, dir = ".") {
   }
 
   # Plumber file found
-  plumber$new(file)
+  Plumber$new(file)
 }
 
 
@@ -91,8 +91,8 @@ plumb <- function(file = NULL, dir = ".") {
 #'
 #' @param package Package to inspect
 #' @param name Name of the package folder to [plumb()].
-#' @describeIn plumb_api [plumb()]s a package's Plumber API. Returns a [`plumber`] router object
-#' @return A [`plumber`] object. If either `package` or `name` is null, the appropriate [available_apis()] will be returned.
+#' @describeIn plumb_api [plumb()]s a package's Plumber API. Returns a [`Plumber`] router object
+#' @return A [`Plumber`] object. If either `package` or `name` is null, the appropriate [available_apis()] will be returned.
 #' @export
 plumb_api <- function(package = NULL, name = NULL) {
 

R/plumber-static.R

@@ -6,7 +6,7 @@
 #' @export
 PlumberStatic <- R6Class(
   "plumberstatic",
-  inherit = plumber,
+  inherit = Plumber,
   public = list(
     #' @description Create a new `plumberstatic` router
     #' @param direc a path to an asset directory.

R/plumber-step.R

@@ -25,7 +25,7 @@ resetForward <- function() {
 #' of a request by a plumber router.
 PlumberStep <- R6Class(
   "PlumberStep",
-  inherit=hookable,
+  inherit=Hookable,
   public = list(
     #' @field lines lines from step block
     lines = NA,
@@ -131,7 +131,7 @@ getRelevantArgs <- function(args, plumberExpression) {
   if (all(fargs %in% c("req", "res"))) {
     ret <- list()
     # using `$` will retrieve the 1st occurance of req,res
-    # args$req <- req is used within `plumber$route()`
+    # args$req <- req is used within `Plumber$route()`
     if ("req" %in% fargs) {
       ret$req <- args$req
     }

R/plumber.R

@@ -25,83 +25,7 @@ defaultPlumberFilters <- list(
   sharedSecret = sharedSecretFilter
 )
 
-#' @keywords internal
-#' @title hookable
-hookable <- R6Class(
-  "hookable",
-  public=list(
-    #' @description Register a hook on a router
-    #' @param stage a character string.
-    #' @param handler a hook function.
-    registerHook = function(stage, handler){
-      private$hooks[[stage]] <- c(private$hooks[[stage]], handler)
-    },
-    #' @description Register hooks on a router
-    #' @param handlers a named list of hook functions.
-    registerHooks = function(handlers){
-      for (i in 1:length(handlers)){
-        stage <- names(handlers)[i]
-        h <- handlers[[i]]
-
-        self$registerHook(stage, h)
-      }
-    }
-  ), private=list(
-    hooks = list( ),
-
-    # Because we're passing in a `value` argument here, `runHooks` will return either the
-    # unmodified `value` argument back, or will allow one or more hooks to modify the value,
-    # in which case the modified value will be returned. Hooks declare that they intend to
-    # modify the value by accepting a parameter named `value`, in which case their returned
-    # value will be used as the updated value.
-    runHooks = function(stage, args) {
-      if (missing(args)) {
-        args <- list()
-      }
 
-      stageHooks <- private$hooks[[stage]]
-      if (length(stageHooks) == 0) {
-        # if there is nothing to execute, return early
-        return(args$value)
-      }
-
-      runSteps(
-        NULL,
-        errorHandlerStep = stop,
-        append(
-          unlist(lapply(stageHooks, function(stageHook) {
-            stageHookArgs <- list()
-            list(
-              function(...) {
-                stageHookArgs <<- getRelevantArgs(args, plumberExpression = stageHook)
-              },
-              function(...) {
-                do.call(stageHook, stageHookArgs) #TODO: envir=private$envir?
-              },
-              # `do.call` could return a promise. Wait for it's return value
-              # if "value" exists in the original args, overwrite it for futher execution
-              function(value, ...) {
-                if ("value" %in% names(stageHookArgs)) {
-                  # Special case, retain the returned value from the hook
-                  # and pass it in as the value for the next handler.
-                  # Ultimately, return value from this function
-                  args$value <<- value
-                }
-                NULL
-              }
-            )
-          })),
-          list(
-            function(...) {
-              # Return the value as passed in or as explcitly modified by one or more hooks.
-              return(args$value)
-            }
-          )
-        )
-      )
-    }
-  )
-)
 
 
 #' Package Plumber Router
@@ -112,17 +36,17 @@ hookable <- R6Class(
 # ' See \url{http://www.rplumber.io/articles/programmatic-usage.html} for additional
 # ' details on the methods available on this object.
 #' @export
-plumber <- R6Class(
-  "plumber",
-  inherit = hookable,
+Plumber <- R6Class(
+  "Plumber",
+  inherit = Hookable,
   public = list(
-    #' @description Create a new `plumber` router
+    #' @description Create a new `Plumber` router
     #'
     #' See also [plumb()], [pr()]
-    #' @param filters a list of plumber filters
+    #' @param filters a list of Plumber filters
     #' @param file path to file to plumb
     #' @param envir an environment to be used as the enclosure for the routers execution
-    #' @return A new `plumber` router
+    #' @return A new `Plumber` router
     initialize = function(file = NULL, filters = defaultPlumberFilters, envir) {
 
       if (!is.null(file)){
@@ -275,23 +199,23 @@ plumber <- R6Class(
 
       httpuv::runServer(host, port, self)
     },
-    #' @description Mount a plumber router
+    #' @description Mount a Plumber router
     #'
     #' Plumber routers can be “nested” by mounting one into another
     #' using the `mount()` method. This allows you to compartmentalize your API
     #' by paths which is a great technique for decomposing large APIs into smaller files.
     #'
     #' See also: [pr_mount()]
     #' @param path a character string. Where to mount router.
-    #' @param router a plumber router. Router to be mounted.
+    #' @param router a Plumber router. Router to be mounted.
     #' @examples
     #' \dontrun{
     #' root <- pr()
     #'
-    #' users <- plumber$new("users.R")
+    #' users <- Plumber$new("users.R")
     #' root$mount("/users", users)
     #'
-    #' products <- plumber$new("products.R")
+    #' products <- Plumber$new("products.R")
     #' root$mount("/products", products)
     #' }
     mount = function(path, router) {
@@ -305,7 +229,7 @@ plumber <- R6Class(
 
       private$mnts[[path]] <- router
     },
-    #' @description Unmount a plumber router
+    #' @description Unmount a Plumber router
     #' @param path a character string. Where to unmount router.
     unmount = function(path) {
       # Ensure that the path has both a leading and trailing slash.
@@ -481,7 +405,7 @@ plumber <- R6Class(
           # base case
           printEndpoints(prefix, name, node, isLast)
 
-        } else if (inherits(node, "plumber")){
+        } else if (is_pr(node)){
           # base case
           cat(prefix, "\u251c\u2500\u2500/", name, "\n", sep="") # "+--"
           # It's a router, let it print itself