Fix Plumber $routes resolution bug. Also print routes in lexicograp…

…hical order.
rstudio · Oct 17, 2020 · b4d7912 · b4d7912
1 parent 284a111
commit b4d7912
Show file tree

Hide file tree

Showing 4 changed files with 50 additions and 8 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -5,6 +5,8 @@ plumber 1.0.0.9999 Development version
 
 * When calling `Plumber$handle()` and defining a new `PlumberEndpoint`, `...` will be checked for invalid names #677  
 
+* Fix Plumber `$routes` resolution bug. Also print routes in lexicographical order. (@meztez #702)
+
 plumber 1.0.0
 --------------------------------------------------------------------------------
 

diff --git a/R/plumber.R b/R/plumber.R
@@ -1020,7 +1020,20 @@ Plumber <- R6Class(
         if (is.null(node)){
           node <- list()
         }
-        node[[children[1]]] <- addPath(node[[children[1]]], children[-1], endpoint)
+        existing_endpoints <-
+          vapply(
+            node[which(names(node) == children[1])],
+            inherits,
+            logical(1),
+            "PlumberEndpoint")
+        if (any(existing_endpoints) && length(children) > 1) {
+          node <- c(
+            node[which(names(node) == children[1])][which(existing_endpoints)],
+            addPath(node[which(names(node) == children[1])][which(!existing_endpoints)], children, endpoint)
+          )
+        } else {
+          node[[children[1]]] <- addPath(node[[children[1]]], children[-1], endpoint)
+        }
         node
       }
 
@@ -1047,9 +1060,17 @@ Plumber <- R6Class(
         }
       }
 
-      # TODO: Sort lexicographically
+      lexisort <- function(paths) {
+        if (is.list(paths)) {
+          paths <- lapply(paths, lexisort)
+          if (!is.null(names(paths))) {
+            paths <- paths[order(names(paths))]
+          }
+        }
+        paths
+      }
 
-      paths
+      lexisort(paths)
     }
   ), private = list(
     default_serializer = NULL, # The default serializer for the router

diff --git a/tests/testthat/test-plumber-print.R b/tests/testthat/test-plumber-print.R
@@ -24,9 +24,6 @@ test_that("prints correctly", {
     "├──[body]",
     "├──[cookieParser]",
     "├──[sharedSecret]",
-    "├──/nested",
-    "│  ├──/path",
-    "│  │  └──/here (GET, POST)",
     "├──/mysubpath",
     "│  │ # Plumber router with 2 endpoints, 4 filters, and 0 sub-routers.",
     "│  ├──[queryString]",
@@ -35,6 +32,9 @@ test_that("prints correctly", {
     "│  ├──[sharedSecret]",
     "│  ├──/ (GET)",
     "│  └──/something (POST)",
+    "├──/nested",
+    "│  ├──/path",
+    "│  │  └──/here (GET, POST)",
     "├──/static",
     "│  │ # Plumber static router serving from directory: ."
   )
@@ -72,9 +72,9 @@ test_that("prints correctly", {
     "│  ├──[cookieParser]",
     "│  ├──[sharedSecret]",
     "│  ├──/ (GET, POST)",
-    "│  ├──/something (POST)",
     "│  ├──/nested",
-    "│  │  └──/path (GET, POST)"
+    "│  │  └──/path (GET, POST)",
+    "│  └──/something (POST)"
   )
 
   expect_equal(printed, expected_output)

diff --git a/tests/testthat/test-plumber.R b/tests/testthat/test-plumber.R
@@ -162,6 +162,25 @@ test_that("routes can be constructed correctly", {
   stat <- PlumberStatic$new(".")
   pr$mount("/static", stat)
 
+  pr3 <- pr()
+  pr_get(pr3, "a/b", function(){})
+  pr_get(pr3, "a", function(){})
+  expect_length(pr3$routes$a, 2)
+
+  pr4 <- pr()
+  pr_get(pr4, "a", function(){})
+  pr_post(pr4, "a/b/c/f", function(){})
+  pr_get(pr4, "a/b/c/f", function(){})
+  pr_get(pr4, "a/b/c/f/g/h/j/k", function(){})
+  pr_get(pr4, "v/b/c/f", function(){})
+  pr_get(pr4, "v/b/c/b", function(){})
+  pr_get(pr4, "v/b/c/a", function(){})
+  pr_get(pr4, "t", function(){})
+  pr_post(pr4, "u/b/c/f", function(){})
+  pr_get(pr4, "i/b/c/f/g/h/j/k", function(){})
+  expect_equal(names(pr4$routes), c("a", "a", "i", "t", "u", "v"))
+  expect_equal(names(pr4$routes$v$b$c), c("a", "b", "f"))
+
   expect_length(pr$routes, 3)
   expect_s3_class(pr$routes[["static"]], "PlumberStatic")
   expect_s3_class(pr$routes[["mysubpath"]], "Plumber")