Merge pull request '2.0: Improve performance, usability.' (#1) from 2.0 into master

Reviewed-on: https://git.nmm.ee/asko/ruuter/pulls/1

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."}))))