path: root/src/ruuter/core.cljc

(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- throw-conflict
  "Throws an exception when two routes define different parameter names at the
  same trie position."
  [slot-type existing-name new-name path]
  (let [msg (str "ruuter: conflicting " slot-type " parameter names at same position — :"
                 (name existing-name) " and :" (name new-name)
                 ". Route: " path)]
    (throw (ex-info msg {:slot-type slot-type
                         :existing-name existing-name
                         :new-name new-name
                         :path path}))))

(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)]
          (when (and existing (not= (:param-name existing) value))
            (throw-conflict "param" (:param-name existing) value (:path leaf)))
          (let [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)]
          (when (and existing (not= (:param-name existing) value))
            (throw-conflict "optional" (:param-name existing) value (:path leaf)))
          (let [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)]
          (when (and existing (not= (:param-name existing) value))
            (throw-conflict "wildcard" (:param-name existing) value (:path leaf)))
          (let [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."}))))