prefix-tree-router!

This commit is contained in:
Tommi Reiman 2017-11-08 09:12:40 +00:00
parent 0d63aa1d43
commit 5d7786936c
6 changed files with 111 additions and 69 deletions

View file

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

View file

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

View file

@ -1,21 +1,13 @@
(ns reitit.trie
(:require [clojure.walk :as walk]
[clojure.string :as str]
[criterium.core :as cc]
[reitit.impl :as impl]))
(set! *warn-on-reflection* true)
(:require [reitit.impl :as impl]))
;;
;; 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
"Return the single character child key for the string started at
index i."
[s i]
(defn- char-key [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)
(let [parts (partition-wilds path-spec)]
(if (impl/contains-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

View file

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

View file

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

View file

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