(ns ruuter.core (:require [clojure.string :as string]) #?(:clj (:gen-class))) (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)) (merge-with reconcile-keys val-in-result val-in-latter) val-in-latter)) (reconcile-maps [result latter] (merge-with reconcile-keys result latter))] (reduce reconcile-maps maps))) (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] (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 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 (map? response) response (fn? response) (response (-> {:params params} (deep-merge req))) :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 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}] (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."}))))