From 8019cebdc745cd0c197b65b3e7b80ffa971c6ae8 Mon Sep 17 00:00:00 2001
From: Tommi Reiman <tommi@iki.fi>
Date: Mon, 20 Nov 2017 08:11:18 +0200
Subject: [PATCH] Segment-router to rule 'em all

---
 modules/reitit-core/src/reitit/segment.cljc   | 50 +++++++++++++++++++
 .../clj/reitit/prefix_tree_perf_test.clj      | 21 +++++++-
 2 files changed, 70 insertions(+), 1 deletion(-)
 create mode 100644 modules/reitit-core/src/reitit/segment.cljc

diff --git a/modules/reitit-core/src/reitit/segment.cljc b/modules/reitit-core/src/reitit/segment.cljc
new file mode 100644
index 00000000..c6300103
--- /dev/null
+++ b/modules/reitit-core/src/reitit/segment.cljc
@@ -0,0 +1,50 @@
+(ns reitit.segment
+  (:require [reitit.impl :as impl]))
+
+(defrecord Match [data params])
+
+(defprotocol Segment
+  (-insert [this ps data])
+  (-lookup [this ps params]))
+
+(extend-protocol Segment
+  nil
+  (-insert [this ps data])
+  (-lookup [this ps params]))
+
+(defn- segments [^String path]
+  (mapv
+    (fn [^String p]
+      (if (impl/wild-param? p) (-> p (subs 1) keyword) p))
+    (.split path "/")))
+
+;; TODO: catch-all
+(defn- segment
+  ([]
+   (segment {} #{} nil))
+  ([children wilds data]
+   (let [children' (impl/fast-map children)]
+     (reify
+       Segment
+       (-insert [_ [p & ps] data]
+         (if-not p
+           (segment children wilds data)
+           (let [wilds (if (keyword? p) (conj wilds p) wilds)
+                 children (update children p #(-insert (or % (segment)) ps data))]
+             (segment children wilds data))))
+       (-lookup [_ [p & ps] params]
+         (if (nil? p)
+           (assoc data :params params)
+           (or (-lookup (impl/fast-get children' p) ps params)
+               (some #(-lookup (impl/fast-get children' %) ps (assoc params % p)) wilds))))))))
+
+(defn create [paths]
+  (reduce
+    (fn [segment [p data]]
+      (let [ps (segments p)]
+        (-insert segment ps (map->Match {:data data}))))
+    (segment) paths))
+
+(defn lookup [segment ^String path]
+  (let [ps (.split path "/")]
+    (-lookup segment ps {})))
diff --git a/perf-test/clj/reitit/prefix_tree_perf_test.clj b/perf-test/clj/reitit/prefix_tree_perf_test.clj
index c607d675..7996201f 100644
--- a/perf-test/clj/reitit/prefix_tree_perf_test.clj
+++ b/perf-test/clj/reitit/prefix_tree_perf_test.clj
@@ -2,6 +2,7 @@
   (:require [clojure.test :refer :all]
             [io.pedestal.http.route.prefix-tree :as p]
             [reitit.trie :as trie]
+            [reitit.segment :as segment]
             [criterium.core :as cc]))
 
 ;;
@@ -75,6 +76,9 @@
       (trie/insert acc p d))
     nil routes))
 
+(def reitit-segment
+  (segment/create routes))
+
 (defn bench! []
 
   ;; 2.3ms
@@ -99,7 +103,22 @@
   ;; 0.8ms (fix payloads)
   (cc/quick-bench
     (dotimes [_ 1000]
-      (trie/lookup reitit-tree "/v1/orgs/1/topics" {}))))
+      (trie/lookup reitit-tree "/v1/orgs/1/topics" {})))
+
+  ;;  0.9ms (initial)
+  ;;  0.5ms (protocols)
+  ;;  1.0ms (with path params)
+  ;;  1.0ms (Match records)
+  ;; 0.63ms (Single sweep path params)
+  ;; 0.51ms (Cleanup)
+  (cc/quick-bench
+    (dotimes [_ 1000]
+      (segment/lookup reitit-segment "/v1/orgs/1/topics"))))
 
 (comment
   (bench!))
+
+(comment
+  (p/lookup pedestal-tree "/v1/orgs/1/topics")
+  (trie/lookup reitit-tree "/v1/orgs/1/topics" {})
+  (segment/lookup reitit-segment "/v1/orgs/1/topics"))