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

Free from the regex!

Browse source
This commit is contained in:
Tommi Reiman 2019-02-02 17:15:59 +02:00
parent 8755e19f78
commit 6f902d118a
11 changed files with 303 additions and 275 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
modules/reitit-core/java-src/reitit/Trie.java
View file

@ -34,7 +34,6 @@ public class Trie {
hasPlus = true; hasPlus = true;
} }
} }
System.err.println();
return decode(chars, offset, count, hasPercent, hasPlus); return decode(chars, offset, count, hasPercent, hasPlus);
} }

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

@ -1,10 +1,11 @@
(ns reitit.core (ns reitit.core
(:require [meta-merge.core :refer [meta-merge]] (:require [clojure.string :as str]
[clojure.string :as str] [reitit.impl :as impl]
[reitit.trie :as trie] [reitit.trie :as trie]))
[reitit.impl :as impl #?@(:cljs [:refer [Route]])])
#?(:clj ;;
(:import (reitit.impl Route)))) ;; Expand
;;
(defprotocol Expand (defprotocol Expand
(expand [this opts])) (expand [this opts]))
@ -30,56 +31,9 @@
nil nil
(expand [_ _])) (expand [_ _]))
(defn walk [raw-routes {:keys [path data routes expand] ;;
:or {data [], routes [], expand expand} ;; Conflicts
:as opts}] ;;
(letfn
[(walk-many [p m r]
(reduce #(into %1 (walk-one p m %2)) [] r))
(walk-one [pacc macc routes]
(if (vector? (first routes))
(walk-many pacc macc routes)
(when (string? (first routes))
(let [[path & [maybe-arg :as args]] routes
[data childs] (if (or (vector? maybe-arg)
(and (sequential? maybe-arg)
(sequential? (first maybe-arg)))
(nil? maybe-arg))
[{} args]
[maybe-arg (rest args)])
macc (into macc (expand data opts))
child-routes (walk-many (str pacc path) macc (keep identity childs))]
(if (seq childs) (seq child-routes) [[(str pacc path) macc]])))))]
(walk-one path (mapv identity data) raw-routes)))
(defn map-data [f routes]
(mapv #(update % 1 f) routes))
(defn merge-data [x]
(reduce
(fn [acc [k v]]
(meta-merge acc {k v}))
{} x))
(defn resolve-routes [raw-routes {:keys [coerce] :as opts}]
(cond->> (->> (walk raw-routes opts) (map-data merge-data))
coerce (into [] (keep #(coerce % opts)))))
(defn path-conflicting-routes [routes]
(-> (into {}
(comp (map-indexed (fn [index route]
[route (into #{}
(filter #(impl/conflicting-routes? route %))
(subvec routes (inc index)))]))
(filter (comp seq second)))
routes)
(not-empty)))
(defn conflicting-paths [conflicts]
(->> (for [[p pc] conflicts]
(conj (map first pc) (first p)))
(apply concat)
(set)))
(defn path-conflicts-str [conflicts] (defn path-conflicts-str [conflicts]
(apply str "Router contains conflicting route paths:\n\n" (apply str "Router contains conflicting route paths:\n\n"
@ -88,15 +42,6 @@
(str " " path "\n-> " (str/join "\n-> " (mapv first vals)) "\n\n")) (str " " path "\n-> " (str/join "\n-> " (mapv first vals)) "\n\n"))
conflicts))) conflicts)))
(defn name-conflicting-routes [routes]
(some->> routes
(group-by (comp :name second))
(remove (comp nil? first))
(filter (comp pos? count butlast second))
(seq)
(map (fn [[k v]] [k (set v)]))
(into {})))
(defn name-conflicts-str [conflicts] (defn name-conflicts-str [conflicts]
(apply str "Router contains conflicting route names:\n\n" (apply str "Router contains conflicting route names:\n\n"
(mapv (mapv
@ -110,23 +55,9 @@
(f conflicts) (f conflicts)
{:conflicts conflicts}))) {:conflicts conflicts})))
(defn- name-lookup [[_ {:keys [name]}] _] ;;
(if name #{name})) ;; Router
;;
(defn- find-names [routes _]
(into [] (keep #(-> % second :name)) routes))
(defn- compile-route [[p m :as route] {:keys [compile] :as opts}]
[p m (if compile (compile route opts))])
(defn- compile-routes [routes opts]
(into [] (keep #(compile-route % opts) routes)))
(defn- uncompile-routes [routes]
(mapv (comp vec (partial take 2)) routes))
(defn route-info [route]
(impl/create route))
(defprotocol Router (defprotocol Router
(router-name [this]) (router-name [this])
@ -162,26 +93,30 @@
([match query-params] ([match query-params]
(some-> match :path (cond-> query-params (str "?" (impl/query-string query-params)))))) (some-> match :path (cond-> query-params (str "?" (impl/query-string query-params))))))
;;
;; Different routers
;;
(defn linear-router (defn linear-router
"Creates a linear-router from resolved routes and optional "Creates a linear-router from resolved routes and optional
expanded options. See [[router]] for available options." expanded options. See [[router]] for available options."
([compiled-routes] ([compiled-routes]
(linear-router compiled-routes {})) (linear-router compiled-routes {}))
([compiled-routes opts] ([compiled-routes opts]
(let [names (find-names compiled-routes opts) (let [names (impl/find-names compiled-routes opts)
[pl nl] (reduce [pl nl] (reduce
(fn [[pl nl] [p {:keys [name] :as data} result]] (fn [[pl nl] [p {:keys [name] :as data} result]]
(let [{:keys [path-params] :as route} (impl/create [p data result]) (let [{:keys [path-params] :as route} (impl/parse p)
f #(if-let [path (impl/path-for route %)] f #(if-let [path (impl/path-for route %)]
(->Match p data result (impl/url-decode-coll %) path) (->Match p data result (impl/url-decode-coll %) path)
(->PartialMatch p data result % path-params))] (->PartialMatch p data result (impl/url-decode-coll %) path-params))]
[(conj pl (-> (trie/insert nil p (->Match p data result nil nil)) (trie/compile))) [(conj pl (-> (trie/insert nil p (->Match p data result nil nil)) (trie/compile)))
(if name (assoc nl name f) nl)])) (if name (assoc nl name f) nl)]))
[[] {}] [[] {}]
compiled-routes) compiled-routes)
lookup (impl/fast-map nl) lookup (impl/fast-map nl)
scanner (trie/scanner pl) scanner (trie/scanner pl)
routes (uncompile-routes compiled-routes)] routes (impl/uncompile-routes compiled-routes)]
^{:type ::router} ^{:type ::router}
(reify (reify
Router Router
@ -219,7 +154,7 @@
(str "can't create :lookup-router with wildcard routes: " wilds) (str "can't create :lookup-router with wildcard routes: " wilds)
{:wilds wilds {:wilds wilds
:routes compiled-routes}))) :routes compiled-routes})))
(let [names (find-names compiled-routes opts) (let [names (impl/find-names compiled-routes opts)
[pl nl] (reduce [pl nl] (reduce
(fn [[pl nl] [p {:keys [name] :as data} result]] (fn [[pl nl] [p {:keys [name] :as data} result]]
[(assoc pl p (->Match p data result {} p)) [(assoc pl p (->Match p data result {} p))
@ -230,7 +165,7 @@
compiled-routes) compiled-routes)
data (impl/fast-map pl) data (impl/fast-map pl)
lookup (impl/fast-map nl) lookup (impl/fast-map nl)
routes (uncompile-routes compiled-routes)] routes (impl/uncompile-routes compiled-routes)]
^{:type ::router} ^{:type ::router}
(reify Router (reify Router
(router-name [_] (router-name [_]
@ -258,20 +193,20 @@
([compiled-routes] ([compiled-routes]
(trie-router compiled-routes {})) (trie-router compiled-routes {}))
([compiled-routes opts] ([compiled-routes opts]
(let [names (find-names compiled-routes opts) (let [names (impl/find-names compiled-routes opts)
[pl nl] (reduce [pl nl] (reduce
(fn [[pl nl] [p {:keys [name] :as data} result]] (fn [[pl nl] [p {:keys [name] :as data} result]]
(let [{:keys [path-params] :as route} (impl/create [p data result]) (let [{:keys [path-params] :as route} (impl/parse p)
f #(if-let [path (impl/path-for route %)] f #(if-let [path (impl/path-for route %)]
(->Match p data result (impl/url-decode-coll %) path) (->Match p data result (impl/url-decode-coll %) path)
(->PartialMatch p data result % path-params))] (->PartialMatch p data result (impl/url-decode-coll %) path-params))]
[(trie/insert pl p (->Match p data result nil nil)) [(trie/insert pl p (->Match p data result nil nil))
(if name (assoc nl name f) nl)])) (if name (assoc nl name f) nl)]))
[nil {}] [nil {}]
compiled-routes) compiled-routes)
pl (trie/compile pl) pl (trie/compile pl)
lookup (impl/fast-map nl) lookup (impl/fast-map nl)
routes (uncompile-routes compiled-routes)] routes (impl/uncompile-routes compiled-routes)]
^{:type ::router} ^{:type ::router}
(reify (reify
Router Router
@ -308,11 +243,11 @@
(ex-info (ex-info
(str ":single-static-path-router requires exactly 1 static route: " compiled-routes) (str ":single-static-path-router requires exactly 1 static route: " compiled-routes)
{:routes compiled-routes}))) {:routes compiled-routes})))
(let [[n :as names] (find-names compiled-routes opts) (let [[n :as names] (impl/find-names compiled-routes opts)
[[p data result]] compiled-routes [[p data result]] compiled-routes
p #?(:clj (.intern ^String p) :cljs p) p #?(:clj (.intern ^String p) :cljs p)
match (->Match p data result {} p) match (->Match p data result {} p)
routes (uncompile-routes compiled-routes)] routes (impl/uncompile-routes compiled-routes)]
^{:type ::router} ^{:type ::router}
(reify Router (reify Router
(router-name [_] (router-name [_]
@ -347,8 +282,8 @@
->static-router (if (= 1 (count lookup)) single-static-path-router lookup-router) ->static-router (if (= 1 (count lookup)) single-static-path-router lookup-router)
wildcard-router (trie-router wild opts) wildcard-router (trie-router wild opts)
static-router (->static-router lookup opts) static-router (->static-router lookup opts)
names (find-names compiled-routes opts) names (impl/find-names compiled-routes opts)
routes (uncompile-routes compiled-routes)] routes (impl/uncompile-routes compiled-routes)]
^{:type ::router} ^{:type ::router}
(reify Router (reify Router
(router-name [_] (router-name [_]
@ -378,13 +313,13 @@
([compiled-routes] ([compiled-routes]
(quarantine-router compiled-routes {})) (quarantine-router compiled-routes {}))
([compiled-routes opts] ([compiled-routes opts]
(let [conflicting-paths (-> compiled-routes path-conflicting-routes conflicting-paths) (let [conflicting-paths (-> compiled-routes impl/path-conflicting-routes impl/conflicting-paths)
conflicting? #(contains? conflicting-paths (first %)) conflicting? #(contains? conflicting-paths (first %))
{conflicting true, non-conflicting false} (group-by conflicting? compiled-routes) {conflicting true, non-conflicting false} (group-by conflicting? compiled-routes)
linear-router (linear-router conflicting opts) linear-router (linear-router conflicting opts)
mixed-router (mixed-router non-conflicting opts) mixed-router (mixed-router non-conflicting opts)
names (find-names compiled-routes opts) names (impl/find-names compiled-routes opts)
routes (uncompile-routes compiled-routes)] routes (impl/uncompile-routes compiled-routes)]
^{:type ::router} ^{:type ::router}
(reify Router (reify Router
(router-name [_] (router-name [_]
@ -407,8 +342,12 @@
(or (match-by-name mixed-router name path-params) (or (match-by-name mixed-router name path-params)
(match-by-name linear-router name path-params))))))) (match-by-name linear-router name path-params)))))))
;;
;; Creating Routers
;;
(defn ^:no-doc default-router-options [] (defn ^:no-doc default-router-options []
{:lookup name-lookup {:lookup (fn [[_ {:keys [name]}] _] (if name #{name}))
:expand expand :expand expand
:coerce (fn [route _] route) :coerce (fn [route _] route)
:compile (fn [[_ {:keys [handler]}] _] handler) :compile (fn [[_ {:keys [handler]}] _] handler)
@ -435,10 +374,10 @@
(router raw-routes {})) (router raw-routes {}))
([raw-routes opts] ([raw-routes opts]
(let [{:keys [router] :as opts} (merge (default-router-options) opts) (let [{:keys [router] :as opts} (merge (default-router-options) opts)
routes (resolve-routes raw-routes opts) routes (impl/resolve-routes raw-routes opts)
path-conflicting (path-conflicting-routes routes) path-conflicting (impl/path-conflicting-routes routes)
name-conflicting (name-conflicting-routes routes) name-conflicting (impl/name-conflicting-routes routes)
compiled-routes (compile-routes routes opts) compiled-routes (impl/compile-routes routes opts)
wilds? (boolean (some impl/wild-route? compiled-routes)) wilds? (boolean (some impl/wild-route? compiled-routes))
all-wilds? (every? impl/wild-route? compiled-routes) all-wilds? (every? impl/wild-route? compiled-routes)
router (cond router (cond

216
modules/reitit-core/src/reitit/impl.cljc
View file

@ -1,12 +1,29 @@
(ns ^:no-doc reitit.impl (ns ^:no-doc reitit.impl
#?(:cljs (:require-macros [reitit.impl])) #?(:cljs (:require-macros [reitit.impl]))
(:require [clojure.string :as str] (:require [clojure.string :as str]
[clojure.set :as set]) [clojure.set :as set]
[meta-merge.core :as mm]
[reitit.trie :as trie])
#?(:clj #?(:clj
(:import (java.util.regex Pattern) (:import (java.util.regex Pattern)
(java.util HashMap Map) (java.util HashMap Map)
(java.net URLEncoder URLDecoder) (java.net URLEncoder URLDecoder))))
(reitit SegmentTrie))))
(defn normalize [s]
(-> s (trie/split-path) (trie/join-path)))
(defrecord Route [path path-parts path-params])
(defn parse [path]
(let [path #?(:clj (.intern ^String (normalize path)) :cljs (normalize path))
path-parts (trie/split-path path)
path-params (->> path-parts (remove string?) (map :value) set)]
(map->Route {:path-params path-params
:path-parts path-parts
:path path})))
(defn wild-route? [[path]]
(-> path parse :path-params seq boolean))
(defn maybe-map-values (defn maybe-map-values
"Applies a function to every value of a map, updates the value if not nil. "Applies a function to every value of a map, updates the value if not nil.
@ -20,107 +37,128 @@
coll coll
coll)) coll))
(defn segments (defn- -slice-start [[p1 :as p1s] [p2 :as p2s]]
"Splits the path into sequence of segments, using `/` char. Assumes that the (let [-split (fn [p]
path starts with `/`, stripping the first empty segment. e.g. (if-let [i (and p (str/index-of p "/"))]
[(subs p 0 i) (subs p i)]
[p]))
-slash (fn [cp p]
(cond
(not (string? cp)) [cp]
(and (string? cp) (not= (count cp) (count p))) [(subs p (count cp))]
(and (string? p) (not cp)) (-split p)))
-postcut (fn [[p :as pps]]
(let [i (and p (str/index-of p "/"))]
(if (and i (pos? i))
(concat [(subs p 0 i) (subs p i)] (rest pps))
pps)))
-tailcut (fn [cp [p :as ps]] (concat (-slash cp p) (rest ps)))]
(if (or (nil? p1) (nil? p2))
[(-postcut p1s) (-postcut p2s)]
(let [cp (and (string? p1) (string? p2) (trie/common-prefix p1 p2))]
[(-tailcut cp p1s) (-tailcut cp p2s)]))))
(segments \"/a/b/c\") ; => (\"a\" \"b\" \"c\") (defn- -slice-end [x xs]
(segments \"/a/) ; => (\"a\" \"\")" (let [i (if (string? x) (str/index-of x "/"))]
[path] (if (and (number? i) (pos? i))
#?(:clj (SegmentTrie/split ^String path) (concat [(subs x i)] xs)
:cljs (rest (.split path #"/" 666)))) xs)))
;; (defn conflicting-routes? [route1 route2]
;; https://github.com/pedestal/pedestal/blob/master/route/src/io/pedestal/http/route/prefix_tree.clj (loop [parts1 (-> route1 first parse :path-parts)
;; parts2 (-> route2 first parse :path-parts)]
(let [[[s1 & ss1] [s2 & ss2]] (-slice-start parts1 parts2)]
(cond
(= s1 s2 nil) true
(or (nil? s1) (nil? s2)) false
(or (trie/catch-all? s1) (trie/catch-all? s2)) true
(or (trie/wild? s1) (trie/wild? s2)) (recur (-slice-end s1 ss1) (-slice-end s2 ss2))
(not= s1 s2) false
:else (recur ss1 ss2)))))
(defn wild? [s] (defn walk [raw-routes {:keys [path data routes expand]
(contains? #{\: \*} (first (str s)))) :or {data [], routes []}
:as opts}]
(letfn
[(walk-many [p m r]
(reduce #(into %1 (walk-one p m %2)) [] r))
(walk-one [pacc macc routes]
(if (vector? (first routes))
(walk-many pacc macc routes)
(when (string? (first routes))
(let [[path & [maybe-arg :as args]] routes
[data childs] (if (or (vector? maybe-arg)
(and (sequential? maybe-arg)
(sequential? (first maybe-arg)))
(nil? maybe-arg))
[{} args]
[maybe-arg (rest args)])
macc (into macc (expand data opts))
child-routes (walk-many (str pacc path) macc (keep identity childs))]
(if (seq childs) (seq child-routes) [[(str pacc path) macc]])))))]
(walk-one path (mapv identity data) raw-routes)))
(defn catch-all? [s] (defn map-data [f routes]
(= \* (first (str s)))) (mapv #(update % 1 f) routes))
(defn wild-param [s] (defn merge-data [x]
(let [ss (str s)] (reduce
(if (= \: (first ss)) (fn [acc [k v]]
(keyword (subs ss 1))))) (mm/meta-merge acc {k v}))
{} x))
(defn catch-all-param [s] (defn resolve-routes [raw-routes {:keys [coerce] :as opts}]
(let [ss (str s)] (cond->> (->> (walk raw-routes opts) (map-data merge-data))
(if (= \* (first ss)) coerce (into [] (keep #(coerce % opts)))))
(keyword (subs ss 1)))))
(defn wild-or-catch-all-param? [x] (defn path-conflicting-routes [routes]
(boolean (or (wild-param x) (catch-all-param x)))) (-> (into {}
(comp (map-indexed (fn [index route]
[route (into #{}
(filter #(conflicting-routes? route %))
(subvec routes (inc index)))]))
(filter (comp seq second)))
routes)
(not-empty)))
(defn contains-wilds? [path] (defn conflicting-paths [conflicts]
(boolean (some wild-or-catch-all-param? (segments path)))) (->> (for [[p pc] conflicts]
(conj (map first pc) (first p)))
(apply concat)
(set)))
;; (defn name-conflicting-routes [routes]
;; https://github.com/pedestal/pedestal/blob/master/route/src/io/pedestal/http/route/path.clj (some->> routes
;; (group-by (comp :name second))
(remove (comp nil? first))
(filter (comp pos? count butlast second))
(seq)
(map (fn [[k v]] [k (set v)]))
(into {})))
(defn- parse-path-token [out string] (defn find-names [routes _]
(condp re-matches string (into [] (keep #(-> % second :name)) routes))
#"^:(.+)$" :>> (fn [[_ token]]
(let [key (keyword token)]
(-> out
(update-in [:path-parts] conj key)
(update-in [:path-params] conj key))))
#"^\*(.*)$" :>> (fn [[_ token]]
(let [key (keyword token)]
(-> out
(update-in [:path-parts] conj key)
(update-in [:path-params] conj key))))
(update-in out [:path-parts] conj string)))
(defn- parse-path (defn compile-route [[p m :as route] {:keys [compile] :as opts}]
([pattern] (parse-path {:path-parts [] :path-params #{}} pattern)) [p m (if compile (compile route opts))])
([accumulated-info pattern]
(if-let [m (re-matches #"/(.*)" pattern)]
(let [[_ path] m]
(reduce parse-path-token
accumulated-info
(str/split path #"/")))
(throw (ex-info "Routes must start from the root, so they must begin with a '/'" {:pattern pattern})))))
;; (defn compile-routes [routes opts]
;; Routing (c) Metosin (into [] (keep #(compile-route % opts) routes)))
;;
(defrecord Route [path path-parts path-params data result]) (defn uncompile-routes [routes]
(mapv (comp vec (partial take 2)) routes))
(defn create [[path data result]]
(let [path #?(:clj (.intern ^String path) :cljs path)
{:keys [path-parts path-params]} (parse-path path)]
(map->Route
{:path-params path-params
:path-parts path-parts
:path path
:result result
:data data})))
(defn wild-route? [[path]]
(contains-wilds? path))
(defn conflicting-routes? [[p1] [p2]]
(loop [[s1 & ss1] (segments p1)
[s2 & ss2] (segments p2)]
(cond
(= s1 s2 nil) true
(or (nil? s1) (nil? s2)) false
(or (catch-all? s1) (catch-all? s2)) true
(or (wild? s1) (wild? s2)) (recur ss1 ss2)
(not= s1 s2) false
:else (recur ss1 ss2))))
(defn path-for [^Route route path-params] (defn path-for [^Route route path-params]
(if-let [required (:path-params route)] (if (:path-params route)
(if (every? #(contains? path-params %) required) (if-let [parts (reduce
(->> (:path-parts route) (fn [acc part]
(map #(get (or path-params {}) % %)) (if (string? part)
(str/join \/) (conj acc part)
(str "/"))) (if-let [p (get path-params (:value part))]
(conj acc p)
(reduced nil))))
[] (:path-parts route))]
(apply str parts))
(:path route))) (:path route)))
(defn throw-on-missing-path-params [template required path-params] (defn throw-on-missing-path-params [template required path-params]

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

@ -3,11 +3,16 @@
(:require [clojure.string :as str]) (:require [clojure.string :as str])
(:import [reitit Trie Trie$Match Trie$Matcher])) (:import [reitit Trie Trie$Match Trie$Matcher]))
(defrecord Wild [value])
(defrecord CatchAll [value])
(defrecord Match [data path-params]) (defrecord Match [data path-params])
(defrecord Node [children wilds catch-all data]) (defrecord Node [children wilds catch-all data])
(defn wild? [x] (instance? Wild x))
(defn catch-all? [x] (instance? CatchAll x))
;; https://stackoverflow.com/questions/8033655/find-longest-common-prefix ;; https://stackoverflow.com/questions/8033655/find-longest-common-prefix
(defn- -common-prefix [s1 s2] (defn common-prefix [s1 s2]
(let [max (min (count s1) (count s2))] (let [max (min (count s1) (count s2))]
(loop [i 0] (loop [i 0]
(cond (cond
@ -26,10 +31,10 @@
(keyword (subs s 0 i) (subs s (inc i))) (keyword (subs s 0 i) (subs s (inc i)))
(keyword s))) (keyword s)))
(defn- -split [s] (defn split-path [s]
(let [-static (fn [from to] (if-not (= from to) [(subs s from to)])) (let [-static (fn [from to] (if-not (= from to) [(subs s from to)]))
-wild (fn [from to] [(-keyword (subs s (inc from) to))]) -wild (fn [from to] [(->Wild (-keyword (subs s (inc from) to)))])
-catch-all (fn [from to] [#{(keyword (subs s (inc from) to))}])] -catch-all (fn [from to] [(->CatchAll (keyword (subs s (inc from) to)))])]
(loop [ss nil, from 0, to 0] (loop [ss nil, from 0, to 0]
(if (= to (count s)) (if (= to (count s))
(concat ss (-static from to)) (concat ss (-static from to))
@ -44,6 +49,15 @@
(recur (concat ss (-static from to) (-catch-all to to')) to' to')) (recur (concat ss (-static from to) (-catch-all to to')) to' to'))
(recur ss from (inc to))))))) (recur ss from (inc to)))))))
(defn join-path [xs]
(reduce
(fn [s x]
(str s (cond
(string? x) x
(instance? Wild x) (str "{" (-> x :value str (subs 1)) "}")
(instance? CatchAll x) (str "{*" (-> x :value str (subs 1)) "}"))))
"" xs))
(defn- -node [m] (defn- -node [m]
(map->Node (merge {:children {}, :wilds {}, :catch-all {}} m))) (map->Node (merge {:children {}, :wilds {}, :catch-all {}} m)))
@ -53,11 +67,11 @@
(nil? path) (nil? path)
(assoc node :data data) (assoc node :data data)
(keyword? path) (instance? Wild path)
(update-in node [:wilds path] (fn [n] (-insert (or n (-node {})) ps data))) (update-in node [:wilds (:value path)] (fn [n] (-insert (or n (-node {})) ps data)))
(set? path) (instance? CatchAll path)
(assoc-in node [:catch-all path] (-node {:data data})) (assoc-in node [:catch-all (:value path)] (-node {:data data}))
(str/blank? path) (str/blank? path)
(-insert node ps data) (-insert node ps data)
@ -66,7 +80,7 @@
(or (or
(reduce (reduce
(fn [_ [p n]] (fn [_ [p n]]
(if-let [cp (-common-prefix p path)] (if-let [cp (common-prefix p path)]
(if (= cp p) (if (= cp p)
;; insert into child node ;; insert into child node
(let [n' (-insert n (conj ps (subs path (count p))) data)] (let [n' (-insert n (conj ps (subs path (count p))) data)]
@ -89,6 +103,10 @@
(update :children dissoc "")) (update :children dissoc ""))
node'))) node')))
;;
;; public api
;;
(defn insert (defn insert
([routes] ([routes]
(insert nil routes)) (insert nil routes))
@ -98,14 +116,14 @@
(insert acc p d)) (insert acc p d))
node routes)) node routes))
([node path data] ([node path data]
(-insert (or node (-node {})) (-split path) data))) (-insert (or node (-node {})) (split-path path) data)))
(defn ^Trie$Matcher compile [{:keys [data children wilds catch-all]}] (defn ^Trie$Matcher compile [{:keys [data children wilds catch-all]}]
(let [matchers (cond-> [] (let [matchers (cond-> []
data (conj (Trie/dataMatcher data)) data (conj (Trie/dataMatcher data))
children (into (for [[p c] children] (Trie/staticMatcher p (compile c)))) children (into (for [[p c] children] (Trie/staticMatcher p (compile c))))
wilds (into (for [[p c] wilds] (Trie/wildMatcher p (compile c)))) wilds (into (for [[p c] wilds] (Trie/wildMatcher p (compile c))))
catch-all (into (for [[p c] catch-all] (Trie/catchAllMatcher (first p) (:data c)))))] catch-all (into (for [[p c] catch-all] (Trie/catchAllMatcher p (:data c)))))]
(if (rest matchers) (if (rest matchers)
(Trie/linearMatcher matchers) (Trie/linearMatcher matchers)
(first matchers)))) (first matchers))))
@ -182,10 +200,10 @@
(compile) (compile)
(pretty)) (pretty))
(-> nil (-> [["/kikka" 2]
(insert "/kikka" 2) ["/kikka/kakka/kukka" 3]
(insert "/kikka/kakka/kukka" 3) ["/kikka/:kakka/kurkku" 4]
(insert "/kikka/:kakka/kurkku" 4) ["/kikka/kuri/{user/doc}/html" 5]]
(insert "/kikka/kuri/{user/doc}/html" 5) (insert)
(compile) (compile)
(pretty)) (pretty))

10
modules/reitit-swagger/src/reitit/swagger.cljc
View file

@ -64,12 +64,8 @@
{:name ::swagger {:name ::swagger
:spec ::spec}) :spec ::spec})
(defn- path->template [path] (defn- swagger-path [path]
(->> (impl/segments path) (-> path impl/normalize (str/replace #"\{\*" "{")))
(map #(if (impl/wild-or-catch-all-param? %)
(str "{" (subs % 1) "}") %))
(str/join "/")
(str "/")))
(defn create-swagger-handler [] (defn create-swagger-handler []
"Create a ring handler to emit swagger spec. Collects all routes from router which have "Create a ring handler to emit swagger spec. Collects all routes from router which have
@ -100,7 +96,7 @@
(strip-top-level-keys swagger))])) (strip-top-level-keys swagger))]))
transform-path (fn [[p _ c]] transform-path (fn [[p _ c]]
(if-let [endpoint (some->> c (keep transform-endpoint) (seq) (into {}))] (if-let [endpoint (some->> c (keep transform-endpoint) (seq) (into {}))]
[(path->template p) endpoint]))] [(swagger-path p) endpoint]))]
(let [paths (->> router (r/compiled-routes) (filter accept-route) (map transform-path) (into {}))] (let [paths (->> router (r/compiled-routes) (filter accept-route) (map transform-path) (into {}))]
{:status 200 {:status 200
:body (meta-merge swagger {:paths paths})}))) :body (meta-merge swagger {:paths paths})})))

9
perf-test/clj/reitit/impl_perf_test.clj
View file

@ -185,15 +185,6 @@
:c "1+1" :c "1+1"
:d "1"})) :d "1"}))
(defn split! []
(suite "split")
;; 114ns (String/split)
;; 82ns (SegmentTrie/split)
(test "Splitting a String")
(test! impl/segments "/olipa/kerran/:avaruus"))
(comment (comment
(url-decode!) (url-decode!)
(url-encode!) (url-encode!)

12
perf-test/clj/reitit/opensensors_perf_test.clj
View file

@ -15,7 +15,8 @@
[io.pedestal.http.route.map-tree :as map-tree] [io.pedestal.http.route.map-tree :as map-tree]
[io.pedestal.http.route.router :as pedestal] [io.pedestal.http.route.router :as pedestal]
[reitit.core :as r] [reitit.core :as r]
[criterium.core :as cc])) [criterium.core :as cc]
[reitit.trie :as trie]))
;; ;;
;; start repl with `lein perf repl` ;; start repl with `lein perf repl`
@ -581,11 +582,11 @@
;; 735ns (maybe-map-values) ;; 735ns (maybe-map-values)
;; 474ns (java-segment-router) ;; 474ns (java-segment-router)
;; 373ms (trie) ;; 373ms (trie)
(b! "reitit-ring" reitit-ring-f) #_(b! "reitit-ring" reitit-ring-f)
;; 385ns (java-segment-router, no injects) ;; 385ns (java-segment-router, no injects)
;; 271ms (trie) ;; 271ms (trie)
(b! "reitit-ring-fast" reitit-ring-fast-f) #_(b! "reitit-ring-fast" reitit-ring-fast-f)
;; 2553ns (linear-router) ;; 2553ns (linear-router)
;; 630ns (segment-router-backed) ;; 630ns (segment-router-backed)
@ -615,6 +616,11 @@
(comment (comment
(bench-rest!)) (bench-rest!))
(-> opensensors-routes
trie/insert
trie/compile
trie/pretty)
(set! *warn-on-reflection* true) (set! *warn-on-reflection* true)
(require '[clj-async-profiler.core :as prof]) (require '[clj-async-profiler.core :as prof])

5
project.clj
View file

@ -68,7 +68,10 @@
[org.clojure/clojurescript "1.10.439"] [org.clojure/clojurescript "1.10.439"]
;; modules dependencies ;; modules dependencies
[metosin/reitit "0.2.13"] ;[metosin/reitit "0.2.13"]
[meta-merge]
[metosin/schema-tools]
[metosin/spec-tools]
[expound "0.7.2"] [expound "0.7.2"]
[orchestra "2018.12.06-2"] [orchestra "2018.12.06-2"]

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

@ -1,6 +1,7 @@
(ns reitit.core-test (ns reitit.core-test
(:require [clojure.test :refer [deftest testing is are]] (:require [clojure.test :refer [deftest testing is are]]
[reitit.core :as r #?@(:cljs [:refer [Match Router]])]) [reitit.core :as r #?@(:cljs [:refer [Match Router]])]
[reitit.impl :as impl])
#?(:clj #?(:clj
(:import (reitit.core Match Router) (:import (reitit.core Match Router)
(clojure.lang ExceptionInfo)))) (clojure.lang ExceptionInfo))))
@ -136,8 +137,9 @@
ExceptionInfo ExceptionInfo
#"can't create :lookup-router with wildcard routes" #"can't create :lookup-router with wildcard routes"
(r/lookup-router (r/lookup-router
(r/resolve-routes (impl/resolve-routes
["/api/:version/ping"] {})))))) ["/api/:version/ping"]
(r/default-router-options)))))))
r/lookup-router :lookup-router r/lookup-router :lookup-router
r/single-static-path-router :single-static-path-router r/single-static-path-router :single-static-path-router
@ -208,7 +210,7 @@
expected [["/auth/login" {:name :auth/login}] expected [["/auth/login" {:name :auth/login}]
["/auth/recovery/token/:token" {:name :auth/recovery}] ["/auth/recovery/token/:token" {:name :auth/recovery}]
["/workspace/:project-uuid/:page-uuid" {:name :workspace/page}]]] ["/workspace/:project-uuid/:page-uuid" {:name :workspace/page}]]]
(is (= expected (r/resolve-routes routes {}))))) (is (= expected (impl/resolve-routes routes (r/default-router-options))))))
(testing "ring sample" (testing "ring sample"
(let [pong (constantly "ok") (let [pong (constantly "ok")
@ -226,7 +228,7 @@
["/api/admin/user" {:mw [:api :admin], :roles #{:user}}] ["/api/admin/user" {:mw [:api :admin], :roles #{:user}}]
["/api/admin/db" {:mw [:api :admin :db], :roles #{:admin}}]] ["/api/admin/db" {:mw [:api :admin :db], :roles #{:admin}}]]
router (r/router routes)] router (r/router routes)]
(is (= expected (r/resolve-routes routes {}))) (is (= expected (impl/resolve-routes routes (r/default-router-options))))
(is (= (r/map->Match (is (= (r/map->Match
{:template "/api/user/:id/:sub-id" {:template "/api/user/:id/:sub-id"
:data {:mw [:api], :parameters {:id "String", :sub-id "String"}} :data {:mw [:api], :parameters {:id "String", :sub-id "String"}}
@ -237,10 +239,10 @@
(deftest conflicting-routes-test (deftest conflicting-routes-test
(testing "path conflicts" (testing "path conflicts"
(are [conflicting? data] (are [conflicting? data]
(let [routes (r/resolve-routes data {}) (let [routes (impl/resolve-routes data (r/default-router-options))
conflicts (-> routes conflicts (-> routes
(r/resolve-routes {}) (impl/resolve-routes (r/default-router-options))
(r/path-conflicting-routes))] (impl/path-conflicting-routes))]
(if conflicting? (seq conflicts) (nil? conflicts))) (if conflicting? (seq conflicts) (nil? conflicts)))
true [["/a"] true [["/a"]
@ -275,8 +277,8 @@
["/:b" {}] #{["/c" {}] ["/*d" {}]}, ["/:b" {}] #{["/c" {}] ["/*d" {}]},
["/c" {}] #{["/*d" {}]}} ["/c" {}] #{["/*d" {}]}}
(-> [["/a"] ["/:b"] ["/c"] ["/*d"]] (-> [["/a"] ["/:b"] ["/c"] ["/*d"]]
(r/resolve-routes {}) (impl/resolve-routes (r/default-router-options))
(r/path-conflicting-routes))))) (impl/path-conflicting-routes)))))
(testing "router with conflicting routes" (testing "router with conflicting routes"
(testing "throws by default" (testing "throws by default"
@ -331,3 +333,13 @@
(let [router (r/router ["/endpoint" (->Named :kikka)])] (let [router (r/router ["/endpoint" (->Named :kikka)])]
(is (= [["/endpoint" {:name :kikka}]] (is (= [["/endpoint" {:name :kikka}]]
(r/routes router))))) (r/routes router)))))
(r/router
[["/:abba" ::abba]
["/abba/1" ::abba2]
["/:jabba/2" ::jabba2]
["/:abba/:dabba/doo" ::doo]
["/abba/dabba/boo/baa" ::baa]
["/abba/:dabba/boo" ::boo]
["/:jabba/:dabba/:doo/:daa/*foo" ::wild]]
{:router r/trie-router})

36
test/cljc/reitit/impl_test.cljc
View file

@ -2,11 +2,37 @@
(:require [clojure.test :refer [deftest testing is are]] (:require [clojure.test :refer [deftest testing is are]]
[reitit.impl :as impl])) [reitit.impl :as impl]))
(deftest segments-test (deftest normalize-test
(is (= ["api" "ipa" "beer" "craft" "bisse"] (are [path expected]
(into [] (impl/segments "/api/ipa/beer/craft/bisse")))) (is (= expected (impl/normalize path)))
(is (= ["a" "" "b" "" "c" ""]
(into [] (impl/segments "/a//b//c/"))))) "/olipa/:kerran/avaruus", "/olipa/{kerran}/avaruus"
"/olipa/{kerran}/avaruus", "/olipa/{kerran}/avaruus"
"/olipa/{a.b/c}/avaruus", "/olipa/{a.b/c}/avaruus"
"/olipa/kerran/*avaruus", "/olipa/kerran/{*avaruus}"
"/olipa/kerran/{*avaruus}", "/olipa/kerran/{*avaruus}"
"/olipa/kerran/{*valvavan.suuri/avaruus}", "/olipa/kerran/{*valvavan.suuri/avaruus}"))
(deftest conflicting-route-test
(are [c? p1 p2]
(is (= c? (impl/conflicting-routes? [p1] [p2])))
true "/a" "/a"
true "/a" "/:a"
true "/a/:b" "/:a/b"
true "/ab/:b" "/:a/ba"
true "/*a" "/:a/ba/ca"
true "/a" "/{a}"
true "/a/{b}" "/{a}/b"
true "/ab/{b}" "/{a}/ba"
true "/{*a}" "/{a}/ba/ca"
false "/a" "/:a/b"
false "/a" "/:a/b"
false "/a" "/{a}/b"
false "/a" "/{a}/b"))
(deftest strip-nils-test (deftest strip-nils-test
(is (= {:a 1, :c false} (impl/strip-nils {:a 1, :b nil, :c false})))) (is (= {:a 1, :c false} (impl/strip-nils {:a 1, :b nil, :c false}))))

60
test/cljc/reitit/swagger_test.clj
View file

@ -32,16 +32,16 @@
:handler (fn [{{{:keys [x y]} :query :handler (fn [{{{:keys [x y]} :query
{:keys [z]} :path} :parameters}] {:keys [z]} :path} :parameters}]
{:status 200, :body {:total (+ x y z)}})} {:status 200, :body {:total (+ x y z)}})}
:post {:summary "plus with body" :post {:summary "plus with body"
:parameters {:body [int?] :parameters {:body [int?]
:path {:z int?}} :path {:z int?}}
:swagger {:responses {400 {:schema {:type "string"} :swagger {:responses {400 {:schema {:type "string"}
:description "kosh"}}} :description "kosh"}}}
:responses {200 {:body {:total int?}} :responses {200 {:body {:total int?}}
500 {:description "fail"}} 500 {:description "fail"}}
:handler (fn [{{{:keys [z]} :path :handler (fn [{{{:keys [z]} :path
xs :body} :parameters}] xs :body} :parameters}]
{:status 200, :body {:total (+ (reduce + xs) z)}})}}]] {:status 200, :body {:total (+ (reduce + xs) z)}})}}]]
["/schema" {:coercion schema/coercion} ["/schema" {:coercion schema/coercion}
["/plus/*z" ["/plus/*z"
@ -72,8 +72,8 @@
(is (= {:body {:total 7}, :status 200} (is (= {:body {:total 7}, :status 200}
(app (app
{:request-method :post {:request-method :post
:uri "/api/spec/plus/3" :uri "/api/spec/plus/3"
:body-params [1 3]})))) :body-params [1 3]}))))
(testing "schema" (testing "schema"
(is (= {:body {:total 6}, :status 200} (is (= {:body {:total 6}, :status 200}
(app (app
@ -142,28 +142,28 @@
:description "kosh"} :description "kosh"}
500 {:description "fail"}} 500 {:description "fail"}}
:summary "plus"} :summary "plus"}
:post {:parameters [{:in "body", :post {:parameters [{:in "body",
:name "", :name "",
:description "", :description "",
:required true, :required true,
:schema {:type "array", :schema {:type "array",
:items {:type "integer", :items {:type "integer",
:format "int64"}}} :format "int64"}}}
{:in "path" {:in "path"
:name "z" :name "z"
:description "" :description ""
:type "integer" :type "integer"
:required true :required true
:format "int64"}] :format "int64"}]
:responses {200 {:description "" :responses {200 {:description ""
:schema {:properties {"total" {:format "int64" :schema {:properties {"total" {:format "int64"
:type "integer"}} :type "integer"}}
:required ["total"] :required ["total"]
:type "object"}} :type "object"}}
400 {:schema {:type "string"} 400 {:schema {:type "string"}
:description "kosh"} :description "kosh"}
500 {:description "fail"}} 500 {:description "fail"}}
:summary "plus with body"}}}}] :summary "plus with body"}}}}]
(is (= expected spec)) (is (= expected spec))
(testing "ring-async swagger-spec" (testing "ring-async swagger-spec"