diff options
| author | Asko Nõmm <asko@nmm.ee> | 2026-02-17 20:29:53 +0200 |
|---|---|---|
| committer | Asko Nõmm <asko@nmm.ee> | 2026-02-17 20:29:53 +0200 |
| commit | d3058cd7e742771d97ec81c9e4ae1e96f954d4a4 (patch) | |
| tree | f13ed9f447ee3b3bb62074d5e8d95bf9bf56ebfa /src/ruuter/core.cljc | |
| parent | 1e2a95e4dab2c7b82c168a6a0fdce7d7485b4a8c (diff) | |
2.0: Improve performance, usability.
This is most likely a breaking change. Though from the API nothing
changes, behaviour does. It will no longer match routes based on
the first match, but rather the best match (the most specific route
wins).
Diffstat (limited to 'src/ruuter/core.cljc')
| -rw-r--r-- | src/ruuter/core.cljc | 388 |
1 files changed, 272 insertions, 116 deletions
diff --git a/src/ruuter/core.cljc b/src/ruuter/core.cljc index dd325cc..1cea393 100644 --- a/src/ruuter/core.cljc +++ b/src/ruuter/core.cljc @@ -1,9 +1,12 @@ (ns ruuter.core (:require - [clojure.string :as string]) + [clojure.string :as string]) #?(:clj (:gen-class))) -(defn deep-merge [& maps] +(defn deep-merge + "Recursively merges maps. When two values for the same key are both maps, + they are merged recursively. Otherwise the latter value wins." + [& maps] (letfn [(reconcile-keys [val-in-result val-in-latter] (if (and (map? val-in-result) (map? val-in-latter)) @@ -13,132 +16,285 @@ (merge-with reconcile-keys result latter))] (reduce reconcile-maps maps))) -(defn- path->regex-path - "Takes in a raw route `path` and turns it into a regex pattern to - match against the request URI." +(defn- param-segment? + "Returns true if the segment string starts with a colon (parameter marker)." + [segment] + (string/starts-with? segment ":")) + +(defn- strip-suffix + "Removes the trailing character and leading colon from a parameter segment, + returning the keyword name. E.g. \":name*\" -> :name" + [segment] + (keyword (subs segment 1 (- (count segment) 1)))) + +(defn- parse-segment + "Parses a single path segment string into a typed descriptor. + Returns a map with :type (:literal, :param, :optional, :wildcard) + and :value (the literal string or parameter name keyword)." + [segment] + (cond + (not (param-segment? segment)) + {:type :literal :value segment} + + (string/ends-with? segment "*") + {:type :wildcard :value (strip-suffix segment)} + + (string/ends-with? segment "?") + {:type :optional :value (strip-suffix segment)} + + :else + {:type :param :value (keyword (subs segment 1))})) + +(defn- path->segments + "Splits a path string into a vector of parsed segment descriptors." [path] - (cond (= "/" path) - "\\/" - - (re-find #"\*" path) - (-> (string/replace path #"\:.*?\*" ".*?") - (string/replace #"/" "\\/")) - - :else - (->> (string/split path #"/") - (map #(cond - ; matches anything, and must be present - ; for example `:name` - (and (string/starts-with? % ":") - (not (string/ends-with? % "?"))) - ".*" - ; matches anything, but is optional - ; for example `:name?` - (and (string/starts-with? % ":") - (string/ends-with? % "?")) - "?.*?" - :else - ; what comes around, goes around - %)) - (string/join "\\/")))) - -(defn- path+uri->path-params - "Takes a raw route `path` and the actual request `uri`, which it then - turns into a map of k:v, if any parameters were used in the `path`." - [path uri] - (cond (= "/" path) - {} - - :else - (let [split-path (->> (string/split path #"/") - (remove empty?) - vec) - split-uri (->> (string/split uri #"/") - (remove empty?) - vec)] - (into {} (map-indexed - (fn [idx item] - (cond - ; required parameter - (and (string/starts-with? item ":") - (not (string/ends-with? item "?")) - (not (string/ends-with? item "*"))) - {(keyword (subs item 1)) (get split-uri idx)} - ; required wildcard parameter - (and (string/starts-with? item ":") - (string/ends-with? item "*")) - {(keyword (-> item - (subs 0 (- (count item) 1)) - (subs 1))) - (->> (drop idx split-uri) - (string/join "/"))} - ; optional parameter - (and (string/starts-with? item ":") - (string/ends-with? item "?") - (get split-uri idx)) - {(keyword (-> item - (subs 0 (- (count item) 1)) - (subs 1))) - (get split-uri idx)})) - split-path))))) - -(defn- match-route - "For a collection of `route`, will attempt to find one that matches - the given `uri` and `request-method`. If none is matched, `nil` will - be returned instead." - [routes uri request-method] - (let [route (->> routes - (filter #(not (= :not-found (:path %)))) - (map #(merge % {:regex-path (path->regex-path (:path %))})) - (filter #(and (re-matches (re-pattern (:regex-path %)) uri) - (= (:method %) request-method))) - first)] - (when route - (dissoc route :regex-path)))) + (if (= "/" path) + [] + (->> (string/split path #"/") + (remove empty?) + (mapv parse-segment)))) + +(defn- empty-node + "Creates an empty trie node." + [] + {:children {} ;; literal segment string -> child node + :param nil ;; {:param-name kw, :node node} or nil + :optional nil ;; {:param-name kw, :node node} or nil + :wildcard nil ;; {:param-name kw, :leaves [...]} or nil + :leaves []}) ;; routes that terminate here [{:method :get :response fn :path str}] + +(defn- insert-route + "Inserts a single route into the trie, returning the updated trie." + [trie segments leaf] + (if (empty? segments) + (update trie :leaves conj leaf) + (let [{:keys [type value]} (first segments) + remaining (subvec segments 1)] + (case type + :literal + (let [child (get-in trie [:children value] (empty-node)) + child' (insert-route child remaining leaf)] + (assoc-in trie [:children value] child')) + + :param + (let [existing (:param trie) + child (if existing (:node existing) (empty-node)) + child' (insert-route child remaining leaf)] + (assoc trie :param {:param-name value :node child'})) + + :optional + (let [existing (:optional trie) + child (if existing (:node existing) (empty-node)) + child' (insert-route child remaining leaf)] + (assoc trie :optional {:param-name value :node child'})) + + :wildcard + (let [existing (:wildcard trie) + leaves (if existing (:leaves existing) []) + leaves' (conj leaves leaf)] + (assoc trie :wildcard {:param-name value :leaves leaves'})))))) + +(defn compile-routes + "Compiles a vector of route maps into a trie structure for efficient + best-match routing. Each route map should have :path, :method, and + :response keys. Routes with :path :not-found are stored separately. + + Returns a map with :trie (the compiled trie) and :not-found (the + fallback route, if any). This is marked with ::compiled metadata + so `route` can detect pre-compiled input." + [routes] + (let [normal (remove #(= :not-found (:path %)) routes) + not-found (->> routes + (filter #(= :not-found (:path %))) + first)] + (with-meta + {:trie (reduce + (fn [trie {:keys [path method response]}] + (let [segments (path->segments path) + leaf {:method method :response response :path path}] + (insert-route trie segments leaf))) + (empty-node) + normal) + :not-found not-found} + {::compiled true}))) + +;; Trie Matching: +;; +;; The matcher walks the trie depth-first, tracking the best match found +;; so far. At each node it tries children in specificity order (literal +;; first, then param, then optional, then wildcard) so the first complete +;; match is often the best, allowing pruning of less-specific branches. +;; +;; Specificity scoring (per segment): +;; literal = 3 +;; param = 2 +;; optional = 1 (skipping an optional penalizes by -1) +;; wildcard = 0 + +(defn- better-match? + "Returns true if `score` beats the current best match." + [score best] + (or (nil? best) (> score (:score best)))) + +(defn- match-leaf + "Checks leaves at a node for a method match. Returns the best result + between `best-so-far` and any matching leaf." + [leaves ctx best-so-far] + (let [{:keys [request-method params score]} ctx] + (reduce (fn [best leaf] + (if (and (= (:method leaf) request-method) + (better-match? score best)) + {:leaf leaf :params params :score score} + best)) + best-so-far + leaves))) + +(defn- match-terminal + "Handles matching when no URI segments remain. Checks leaves at the + current node and any optional child that can match zero segments." + [{:keys [node best] :as ctx}] + (let [best (match-leaf (:leaves node) ctx best)] + (if-let [{:keys [node]} (:optional node)] + (match-leaf (:leaves node) ctx best) + best))) + +(declare ^:private match-trie) + +(defn- try-literal + "Tries to match the current segment as a literal child (+3 specificity)." + [ctx seg rest-segs best] + (if-let [child (get (:children (:node ctx)) seg)] + (match-trie (assoc ctx + :node child + :segments rest-segs + :score (+ (:score ctx) 3) + :best best)) + best)) + +(defn- try-param + "Tries to match via a required parameter child (+2 specificity)." + [ctx seg rest-segs best] + (if-let [{:keys [param-name node]} (:param (:node ctx))] + (match-trie (-> ctx + (update :params assoc param-name seg) + (assoc :node node + :segments rest-segs + :score (+ (:score ctx) 2) + :best best))) + best)) + +(defn- try-optional-consume + "Tries to match via an optional parameter child, consuming the segment (+1)." + [ctx seg rest-segs best] + (if-let [{:keys [param-name node]} (:optional (:node ctx))] + (match-trie (-> ctx + (update :params assoc param-name seg) + (assoc :node node + :segments rest-segs + :score (+ (:score ctx) 1) + :best best))) + best)) + +(defn- try-optional-skip + "Tries to skip an optional parameter child without consuming any segment (-1)." + [ctx best] + (if-let [{:keys [node]} (:optional (:node ctx))] + (match-trie (assoc ctx + :node node + :score (dec (:score ctx)) + :best best)) + best)) + +(defn- try-wildcard + "Tries to match a wildcard child, consuming all remaining segments (+0)." + [ctx best] + (if-let [{:keys [param-name leaves]} (:wildcard (:node ctx))] + (let [updated-param (string/join "/" (:segments ctx)) + updated-ctx (update ctx :params assoc param-name updated-param)] + (match-leaf leaves updated-ctx best)) + best)) + +(defn- match-trie + "Walks the trie depth-first to find the best matching route for the + given URI segments. Tries children in specificity order (literal > + param > optional > wildcard), threading the best match through each. + Returns {:leaf :params :score} or nil." + [{:keys [segments] :as ctx}] + (if (empty? segments) + (match-terminal ctx) + (let [seg (first segments) + rest-segs (subvec segments 1) + best (:best ctx)] + (->> best + (try-literal ctx seg rest-segs) + (try-param ctx seg rest-segs) + (try-optional-consume ctx seg rest-segs) + (try-optional-skip ctx) + (try-wildcard ctx))))) + +(def ^:private compile-routes* + "Memoized version of compile-routes for implicit compilation." + (memoize compile-routes)) + +(defn- compiled? + "Returns true if the given value is a pre-compiled route trie." + [x] + (and (map? x) (::compiled (meta x)))) + +(defn- ensure-compiled + "Returns a compiled trie, either by passing through a pre-compiled one + or by compiling a routes vector (memoized)." + [routes] + (if (compiled? routes) + routes + (compile-routes* routes))) (defn- route+req->response - "Given the current route and the current HTTP request, it will - attempt to return a response, either directly if it's a map or - indirectly if it's a function. In case of a function, it will also - pass along the request map with added-in params that were parsed - from the route path. - - If the response is invalid, or does not exist, a error message with - status code 404 will be returned instead." - [{:keys [path response]} {:keys [uri] :as req}] + "Given the matched route, extracted params, and the original HTTP request, + returns a response map. If response is a map, returns it directly. + If response is a function, calls it with the request augmented with :params. + Otherwise returns a 404." + [{:keys [response]} params req] (cond - ; responses are maps, so there's no reason they can't be - ; direct maps. (map? response) response - ; responses can also be functions that return maps, and - ; when using a function, you get the whole `req` and params - ; with it as well. + (fn? response) - (response (-> {:params (path+uri->path-params path uri)} + (response (-> {:params params} (deep-merge req))) - ; if by whatever reason we make it here it must mean the - ; route is invalid, or doesn't exist, in which case we return - ; an error message. + :else {:status 404 :body "Not found."})) (defn route "For a given collection of `routes` and the current HTTP request as - `req`, will attempt to match a route with the HTTP request, which it - will then try to return a response for. The only requirement for `req` - is to contain both a `uri` and `request-method` key. First should match - the request path (like the paths defined in routes) and the second - should match the request method used by the HTTP server you pass this fn to. - - If no route matched for a given HTTP request it will try to find a - route with `:not-found` as its `:path` instead, and return the response - for that, and if that route was also not found, will return a built-in - 404 response instead." + `req`, will attempt to match the best route for the HTTP request and + return its response. + + Routes are matched using specificity-based best-match semantics: + literal segments beat parameters, parameters beat optionals, and + optionals beat wildcards. Route order in the vector does not matter. + + `routes` can be either a raw vector of route maps (compiled implicitly + and cached via memoization) or a pre-compiled trie from `compile-routes`. + + If no route matched, it will try to find a route with `:not-found` as + its `:path`, and if that is also missing, returns a built-in 404." [routes {:keys [uri request-method] :as req}] - (if-let [route (match-route routes uri request-method)] - (route+req->response route req) - (route+req->response (->> routes - (filter #(= :not-found (:path %))) - first) req))) + (let [{:keys [trie not-found]} (ensure-compiled routes) + segments (->> (string/split uri #"/") + (remove empty?) + vec) + match (match-trie {:node trie + :segments segments + :request-method request-method + :params {} + :score 0 + :best nil})] + (if match + (route+req->response (:leaf match) (:params match) req) + (if not-found + (route+req->response not-found {} req) + {:status 404 + :body "Not found."})))) |
