prefix-tree-router!

modules/reitit-core/src/reitit/core.cljc

@@ -1,6 +1,7 @@
 (ns reitit.core
   (:require [meta-merge.core :refer [meta-merge]]
             [clojure.string :as str]
+            [reitit.trie :as trie]
             [reitit.impl :as impl #?@(:cljs [:refer [Route]])])
   #?(:clj
      (:import (reitit.impl Route))))
@@ -216,6 +217,46 @@
          (if-let [match (impl/fast-get lookup name)]
            (match params)))))))
 
+(defn prefix-tree-router
+  "Creates a prefix-tree router from resolved routes and optional
+  expanded options. See [[router]] for available options"
+  ([routes]
+   (prefix-tree-router routes {}))
+  ([routes opts]
+   (let [compiled (compile-routes routes opts)
+         names (find-names routes opts)
+         [node lookup] (reduce
+                         (fn [[node lookup] [p {:keys [name] :as meta} result]]
+                           (let [{:keys [params] :as route} (impl/create [p meta result])
+                                 f #(if-let [path (impl/path-for route %)]
+                                      (->Match p meta result % path)
+                                      (->PartialMatch p meta result % params))]
+                             [(trie/insert node p (->Match p meta result nil nil))
+                              (if name (assoc lookup name f) lookup)]))
+                         [nil {}] compiled)
+         lookup (impl/fast-map lookup)]
+     (reify
+       Router
+       (router-name [_]
+         :prefix-tree-router)
+       (routes [_]
+         compiled)
+       (options [_]
+         opts)
+       (route-names [_]
+         names)
+       (match-by-path [_ path]
+         (if-let [match (trie/lookup node path {})]
+           (-> (:data match)
+               (assoc :params (:params match))
+               (assoc :path path))))
+       (match-by-name [_ name]
+         (if-let [match (impl/fast-get lookup name)]
+           (match nil)))
+       (match-by-name [_ name params]
+         (if-let [match (impl/fast-get lookup name)]
+           (match params)))))))
+
 (defn single-static-path-router
   "Creates a fast router of 1 static route(s) and optional
   expanded options. See [[router]] for available options"
@@ -252,16 +293,16 @@
 
 (defn mixed-router
   "Creates two routers: [[lookup-router]] or [[single-static-path-router]] for
-  static routes and [[linear-router]] for wildcard routes. All
+  static routes and [[prefix-tree-router]] for wildcard routes. All
   routes should be non-conflicting. Takes resolved routes and optional
   expanded options. See [[router]] for options."
   ([routes]
    (mixed-router routes {}))
   ([routes opts]
-   (let [{linear true, lookup false} (group-by impl/wild-route? routes)
+   (let [{wild true, lookup false} (group-by impl/wild-route? routes)
          compiled (compile-routes routes opts)
          ->static-router (if (= 1 (count lookup)) single-static-path-router lookup-router)
-         wildcard-router (linear-router linear opts)
+         wildcard-router (prefix-tree-router wild opts)
          static-router (->static-router lookup opts)
          names (find-names routes opts)]
      (reify Router
@@ -310,9 +351,9 @@
                   router router
                   (and (= 1 (count routes)) (not wilds?)) single-static-path-router
                   (not wilds?) lookup-router
-                  all-wilds? linear-router
+                  all-wilds? prefix-tree-router
                   (not conflicting) mixed-router
-                  :else linear-router)]
+                  :else prefix-tree-router)]
 
      (when-let [conflicts (:conflicts opts)]
        (when conflicting (conflicts conflicting)))

modules/reitit-core/src/reitit/impl.cljc

@@ -69,10 +69,20 @@
 ;; (c) https://github.com/pedestal/pedestal/blob/master/route/src/io/pedestal/http/route/prefix_tree.clj
 ;;
 
-(defn- wild? [s]
+(defn wild? [s]
   (contains? #{\: \*} (first s)))
 
-(defn- partition-wilds
+(defn wild-param?
+  "Return true if a string segment starts with a wildcard string."
+  [segment]
+  (= \: (first segment)))
+
+(defn catch-all-param?
+  "Return true if a string segment starts with a catch-all string."
+  [segment]
+  (= \* (first segment)))
+
+(defn partition-wilds
   "Given a path-spec string, return a seq of strings with wildcards
   and catch-alls separated into their own strings. Eats the forward
   slash following a wildcard."

modules/reitit-core/src/reitit/trie.cljc

@@ -1,21 +1,13 @@
 (ns reitit.trie
-  (:require [clojure.walk :as walk]
+  (:require [reitit.impl :as impl]))
-            [clojure.string :as str]
-            [criterium.core :as cc]
-            [reitit.impl :as impl]))
-
-(set! *warn-on-reflection* true)
 
 ;;
-;; Prefix-tree-router
+;; original https://github.com/pedestal/pedestal/blob/master/route/src/io/pedestal/http/route/prefix_tree.clj
 ;;
 
 (declare insert)
 
-(defn- char-key
+(defn- char-key [s i]
-  "Return the single character child key for the string started at
-  index i."
-  [s i]
   (if (< i (count s))
     (subs s i (inc i))))
 
@@ -40,7 +32,7 @@
 
 (defrecord Match [data params])
 
-(defn wild-node [segment param children data]
+(defn- wild-node [segment param children data]
   (let [?wild (maybe-wild-node children)
         ?catch (maybe-catch-all-node children)
         children' (impl/fast-map children)]
@@ -66,7 +58,7 @@
       (insert-child [_ key path-spec child-data]
         (wild-node segment param (update children key insert path-spec child-data) data)))))
 
-(defn catch-all-node [segment children param data]
+(defn- catch-all-node [segment children param data]
   (reify
     Node
     (lookup [_ path params]
@@ -74,7 +66,7 @@
     (get-segment [_]
       segment)))
 
-(defn static-node [^String segment children data]
+(defn- static-node [^String segment children data]
   (let [size (count segment)
         ?wild (maybe-wild-node children)
         ?catch (maybe-catch-all-node children)
@@ -82,10 +74,10 @@
     (reify
       Node
       (lookup [_ path params]
-        (if (.equals segment path)
+        (if (#?(:clj .equals, :cljs =) segment path)
           (->Match data params)
           (let [p (if (>= (count path) size) (subs path 0 size))]
-            (if (.equals segment p)
+            (if (#?(:clj .equals, :cljs =) segment p)
               (let [child (impl/fast-get children' (char-key path size))
                     path (subs path size)]
                 (or (lookup child path params)
@@ -102,53 +94,15 @@
       (insert-child [_ key path-spec child-data]
         (static-node segment (update children key insert path-spec child-data) data)))))
 
-(defn- wild? [s]
-  (contains? #{\: \*} (first s)))
-
-(defn- wild-param?
-  "Return true if a string segment starts with a wildcard string."
-  [segment]
-  (= \: (first segment)))
-
-(defn- catch-all-param?
-  "Return true if a string segment starts with a catch-all string."
-  [segment]
-  (= \* (first segment)))
-
-(defn partition-wilds
-  "Given a path-spec string, return a seq of strings with wildcards
-  and catch-alls separated into their own strings. Eats the forward
-  slash following a wildcard."
-  [path-spec]
-  (let [groups (partition-by wild? (str/split path-spec #"/"))
-        first-groups (butlast groups)
-        last-group (last groups)]
-    (flatten
-      (conj (mapv #(if (wild? (first %))
-                     %
-                     (str (str/join "/" %) "/"))
-                  first-groups)
-            (if (wild? (first last-group))
-              last-group
-              (str/join "/" last-group))))))
-
-(defn contains-wilds?
-  "Return true if the given path-spec contains any wildcard params or
-  catch-alls."
-  [path-spec]
-  (let [parts (partition-wilds path-spec)]
-    (or (> (count parts) 1)
-        (wild? (first parts)))))
-
 (defn- make-node
   "Given a path-spec segment string and a payload object, return a new
   tree node."
   [segment data]
   (cond
-    (wild-param? segment)
+    (impl/wild-param? segment)
     (wild-node segment (keyword (subs segment 1)) nil data)
 
-    (catch-all-param? segment)
+    (impl/catch-all-param? segment)
     (catch-all-node segment (keyword (subs segment 1)) nil data)
 
     :else
@@ -159,10 +113,10 @@
   the path-spec contains wildcards or catch-alls, will return parent
   node of a tree (linked list)."
   [path-spec data]
-  (if (contains-wilds? path-spec)
+  (if (impl/contains-wilds? path-spec)
-    (let [parts (partition-wilds path-spec)]
+    (let [parts (impl/partition-wilds path-spec)]
       (reduce (fn [child segment]
-                (when (catch-all-param? segment)
+                (when (impl/catch-all-param? segment)
                   (throw (ex-info "catch-all may only appear at the end of a path spec"
                                   {:patch-spec path-spec})))
                 (-> (make-node segment nil)
@@ -216,7 +170,7 @@
           (set-data node data)
 
           ;; handle case where path-spec is a wildcard param
-          (wild-param? path-spec)
+          (impl/wild-param? path-spec)
           (let [lcs (calc-lcs segment path-spec)
                 common (subs path-spec 0 lcs)]
             (if (= common segment)
@@ -229,7 +183,7 @@
 
           ;; in the case where path-spec is a catch-all, node should always be nil.
           ;; getting here means we have an invalid route specification
-          (catch-all-param? path-spec)
+          (impl/catch-all-param? path-spec)
           (throw (ex-info "route conflict"
                           {:node node
                            :path-spec path-spec

perf-test/clj/reitit/opensensors_routing_test.clj

@@ -565,10 +565,12 @@
 
     ;;  2538ns
     ;;  2065ns
+    ;;   680ns (prefix-tree-router)
     (bench!! routes true "reitit" reitit-f)
 
     ;;  2845ns
     ;;  2316ns
+    ;;   947ns (prefix-tree-router)
     (bench!! routes true "reitit-ring" reitit-ring-f)
 
     ;;  2541ns

perf-test/clj/reitit/perf_test.clj

@@ -148,6 +148,7 @@
         (call))))
 
   ;; 710 µs (3-18x)
+  ;; 540 µs (4-23x) -23% prefix-tree-router
   (title "reitit")
   (let [call #(reitit/match-by-path reitit-routes "/workspace/1/1")]
     (assert (call))

test/cljc/reitit/core_test.cljc

@@ -7,8 +7,42 @@
 
 (deftest reitit-test
 
-  (testing "linear-router"
+  (testing "prefix-tree-router"
     (let [router (r/router ["/api" ["/ipa" ["/:size" ::beer]]])]
+      (is (= :prefix-tree-router (r/router-name router)))
+      (is (= [["/api/ipa/:size" {:name ::beer} nil]]
+             (r/routes router)))
+      (is (= true (map? (r/options router))))
+      (is (= (r/map->Match
+               {:template "/api/ipa/:size"
+                :meta {:name ::beer}
+                :path "/api/ipa/large"
+                :params {:size "large"}})
+             (r/match-by-path router "/api/ipa/large")))
+      (is (= (r/map->Match
+               {:template "/api/ipa/:size"
+                :meta {:name ::beer}
+                :path "/api/ipa/large"
+                :params {:size "large"}})
+             (r/match-by-name router ::beer {:size "large"})))
+      (is (= nil (r/match-by-name router "ILLEGAL")))
+      (is (= [::beer] (r/route-names router)))
+
+      (testing "name-based routing with missing parameters"
+        (is (= (r/map->PartialMatch
+                 {:template "/api/ipa/:size"
+                  :meta {:name ::beer}
+                  :required #{:size}
+                  :params nil})
+               (r/match-by-name router ::beer)))
+        (is (= true (r/partial-match? (r/match-by-name router ::beer))))
+        (is (thrown-with-msg?
+              ExceptionInfo
+              #"^missing path-params for route /api/ipa/:size -> \#\{:size\}$"
+              (r/match-by-name! router ::beer))))))
+
+  (testing "linear-router"
+    (let [router (r/router ["/api" ["/ipa" ["/:size" ::beer]]] {:router r/linear-router})]
       (is (= :linear-router (r/router-name router)))
       (is (= [["/api/ipa/:size" {:name ::beer} nil]]
              (r/routes router)))