luciano/reitit
1
0
Fork 0
mirror of https://github.com/metosin/reitit.git synced 2025-12-17 16:31:11 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

Remove prefix-tree router as it's broken

Browse source
This commit is contained in:
Tommi Reiman 2017-11-24 09:45:52 +02:00
parent 4490fc1685
commit e0786b73f0
4 changed files with 3 additions and 289 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

42
modules/reitit-core/src/reitit/core.cljc
View file

@ -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"

241
modules/reitit-core/src/reitit/trie.cljc
View file

@ -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))))

7
perf-test/clj/reitit/prefix_tree_perf_test.clj
View file

@ -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"))

2
test/cljc/reitit/core_test.cljc
View file

@ -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))