diff --git a/modules/reitit-core/src/reitit/core.cljc b/modules/reitit-core/src/reitit/core.cljc index 43d7656f..656f7156 100644 --- a/modules/reitit-core/src/reitit/core.cljc +++ b/modules/reitit-core/src/reitit/core.cljc @@ -1,7 +1,6 @@ (ns reitit.core (:require [meta-merge.core :refer [meta-merge]] [clojure.string :as str] - [reitit.trie :as trie] [reitit.segment :as segment] [reitit.impl :as impl #?@(:cljs [:refer [Route]])]) #?(:clj @@ -220,47 +219,6 @@ (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) - [pl nl] (reduce - (fn [[pl nl] [p {:keys [name] :as data} result]] - (let [{:keys [params] :as route} (impl/create [p data result]) - f #(if-let [path (impl/path-for route %)] - (->Match p data result % path) - (->PartialMatch p data result % params))] - [(trie/insert pl p (->Match p data result nil nil)) - (if name (assoc nl name f) nl)])) - [nil {}] compiled) - lookup (impl/fast-map nl)] - ^{:type ::router} - (reify - Router - (router-name [_] - :prefix-tree-router) - (routes [_] - compiled) - (options [_] - opts) - (route-names [_] - names) - (match-by-path [_ path] - (if-let [match (trie/lookup pl 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 segment-router "Creates a special prefix-tree style segment router from resolved routes and optional expanded options. See [[router]] for available options" diff --git a/modules/reitit-core/src/reitit/trie.cljc b/modules/reitit-core/src/reitit/trie.cljc deleted file mode 100644 index 6f2208d3..00000000 --- a/modules/reitit-core/src/reitit/trie.cljc +++ /dev/null @@ -1,241 +0,0 @@ -(ns reitit.trie - (:require [reitit.impl :as impl] - [clojure.string :as str])) - -;; -;; original https://github.com/pedestal/pedestal/blob/master/route/src/io/pedestal/http/route/prefix_tree.clj -;; - -(declare insert) - -(defn- char-key [s i] - (if (< i (count s)) - (subs s i (inc i)))) - -(defn- maybe-wild-node [children] - (get children ":")) - -(defn- maybe-catch-all-node [children] - (get children "*")) - -(defprotocol Node - (lookup [this path params]) - (get-segment [this]) - (update-segment [this subs lcs]) - (get-data [this]) - (set-data [this data]) - (get-chidren [this]) - (add-child [this key child]) - (insert-child [this key path-spec data])) - -(extend-protocol Node - nil - (lookup [_ _ _]) - (get-segment [_])) - -(defrecord Match [data params]) - -(defn- wild-node [segment param children data] - (let [?wild (maybe-wild-node children) - ?catch (maybe-catch-all-node children) - children' (impl/fast-map children)] - ^{:type ::node} - (reify - Node - (lookup [_ path params] - (let [i (.indexOf ^String path "/")] - (if (pos? i) - (let [value (subs path 0 i)] - (let [child (impl/fast-get children' (char-key path (inc i))) - path' (subs path (inc i)) - params (assoc params param value)] - (or (lookup child path' params) - (lookup ?wild path' params) - (lookup ?catch path' params)))) - (->Match data (assoc params param path))))) - (get-segment [_] - segment) - (get-data [_] - data) - (set-data [_ data] - (wild-node segment param children data)) - (get-chidren [_] - children) - (add-child [_ key child] - (wild-node segment param (assoc children key child) data)) - (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] - ^{:type ::node} - (reify - Node - (lookup [_ path params] - (->Match data (assoc params param path))) - (get-segment [_] - segment) - (get-data [_] - data) - (get-chidren [_] - children))) - -(defn- static-node [^String segment children data] - (let [size (count segment) - ?wild (maybe-wild-node children) - ?catch (maybe-catch-all-node children) - children' (impl/fast-map children)] - ^{:type ::node} - (reify - Node - (lookup [_ path params] - (if (#?(:clj .equals, :cljs =) segment path) - (->Match data params) - (let [p (if (>= (count path) size) (subs path 0 size))] - (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) - (lookup ?wild path params) - (lookup ?catch path params))))))) - (get-segment [_] - segment) - (update-segment [_ subs lcs] - (static-node (subs segment lcs) children data)) - (get-data [_] - data) - (set-data [_ data] - (static-node segment children data)) - (get-chidren [_] - children) - (add-child [_ key child] - (static-node segment (assoc children key child) data)) - (insert-child [_ key path-spec child-data] - (static-node segment (update children key insert path-spec child-data) data))))) - -(defn- make-node - "Given a path-spec segment string and a payload object, return a new - tree node." - [segment data] - (cond - (impl/wild-param segment) - (wild-node segment (keyword (subs segment 1)) nil data) - - (impl/catch-all-param segment) - (catch-all-node segment (keyword (subs segment 1)) nil data) - - :else - (static-node segment nil data))) - -(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 impl/wild? (str/split path-spec #"/")) - first-groups (butlast groups) - last-group (last groups)] - (flatten - (conj (mapv #(if (impl/wild? (first %)) - % - (str (str/join "/" %) "/")) - first-groups) - (if (impl/wild? (first last-group)) - last-group - (str/join "/" last-group)))))) - -(defn- new-node - "Given a path-spec and a payload object, return a new tree node. If - the path-spec contains wildcards or catch-alls, will return parent - node of a tree (linked list)." - [path-spec data] - (if (impl/contains-wilds? path-spec) - (let [parts (partition-wilds path-spec)] - (reduce (fn [child 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) - (add-child (subs (get-segment child) 0 1) child))) - (let [segment (last parts)] - (make-node segment data)) - (reverse (butlast parts)))) - (make-node path-spec data))) - -(defn- calc-lcs - "Given two strings, return the end index of the longest common - prefix string." - [s1 s2] - (loop [i 1] - (cond (or (< (count s1) i) - (< (count s2) i)) - (dec i) - - (= (subs s1 0 i) - (subs s2 0 i)) - (recur (inc i)) - - :else (dec i)))) - -(defn- split - "Given a node, a path-spec, a payload object to insert into the tree - and the lcs, split the node and return a new parent node with the - old contents of node and the new item as children. - lcs is the index of the longest common string in path-spec and the - segment of node." - [node path-spec data lcs] - (let [segment (get-segment node) - common (subs path-spec 0 lcs) - parent (new-node common nil)] - (if (= common path-spec) - (-> (set-data parent data) - (add-child (char-key segment lcs) (update-segment node subs lcs))) - (-> parent - (add-child (char-key segment lcs) (update-segment node subs lcs)) - (insert-child (char-key path-spec lcs) (subs path-spec lcs) data))))) - -(defn insert - "Given a tree node, a path-spec and a payload object, return a new - tree with payload inserted." - [node path-spec data] - (let [segment (get-segment node)] - (cond (nil? node) - (new-node path-spec data) - - (= segment path-spec) - (set-data node data) - - ;; handle case where path-spec is a wildcard param - (impl/wild-param path-spec) - (let [lcs (calc-lcs segment path-spec) - common (subs path-spec 0 lcs)] - (if (= common segment) - (let [path-spec (subs path-spec (inc lcs))] - (insert-child node (subs path-spec 0 1) path-spec data)) - (throw (ex-info "route conflict" - {:node node - :path-spec path-spec - :segment segment})))) - - ;; in the case where path-spec is a catch-all, node should always be nil. - ;; getting here means we have an invalid route specification - (impl/catch-all-param path-spec) - (throw (ex-info "route conflict" - {:node node - :path-spec path-spec - :segment segment})) - - :else - (let [lcs (calc-lcs segment path-spec)] - (cond (= lcs (count segment)) - (insert-child node (char-key path-spec lcs) (subs path-spec lcs) data) - - :else - (split node path-spec data lcs)))))) - -(defn view - "Returns a view representation of a prefix-tree." - [x] - (vec (concat - [(get-segment x)] - (some->> (get-chidren x) vals seq (map view)) - (some->> (get-data x) vector)))) diff --git a/perf-test/clj/reitit/prefix_tree_perf_test.clj b/perf-test/clj/reitit/prefix_tree_perf_test.clj index 7996201f..1f09421e 100644 --- a/perf-test/clj/reitit/prefix_tree_perf_test.clj +++ b/perf-test/clj/reitit/prefix_tree_perf_test.clj @@ -1,7 +1,6 @@ (ns reitit.prefix-tree-perf-test (: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])) @@ -70,7 +69,7 @@ (p/insert acc p d)) nil routes)) -(def reitit-tree +#_(def reitit-tree (reduce (fn [acc [p d]] (trie/insert acc p d)) @@ -101,7 +100,7 @@ ;; 0.8ms (flattened matching) ;; 0.8ms (return route-data) ;; 0.8ms (fix payloads) - (cc/quick-bench + #_(cc/quick-bench (dotimes [_ 1000] (trie/lookup reitit-tree "/v1/orgs/1/topics" {}))) @@ -120,5 +119,5 @@ (comment (p/lookup pedestal-tree "/v1/orgs/1/topics") - (trie/lookup reitit-tree "/v1/orgs/1/topics" {}) + #_(trie/lookup reitit-tree "/v1/orgs/1/topics" {}) (segment/lookup reitit-segment "/v1/orgs/1/topics")) diff --git a/test/cljc/reitit/core_test.cljc b/test/cljc/reitit/core_test.cljc index ef518ffa..0062cccb 100644 --- a/test/cljc/reitit/core_test.cljc +++ b/test/cljc/reitit/core_test.cljc @@ -65,7 +65,6 @@ ))) r/linear-router :linear-router - #_#_r/prefix-tree-router :prefix-tree-router r/segment-router :segment-router r/mixed-router :mixed-router)) @@ -102,7 +101,6 @@ r/lookup-router :lookup-router r/single-static-path-router :single-static-path-router r/linear-router :linear-router - r/prefix-tree-router :prefix-tree-router r/segment-router :segment-router r/mixed-router :mixed-router))