;; lib/dream/router.sx — Dream-on-SX routing. ;; Routes are dicts {:method :path :handler}; a router is a handler that ;; dispatches request -> response by method + path, extracting :name path ;; params and binding a ** catch-all. No match -> 404. Depends on types.sx. ;; ── route constructors (one per HTTP method) ─────────────────────── (define dream-get (fn (path handler) (dream-route "GET" path handler))) (define dream-post (fn (path handler) (dream-route "POST" path handler))) (define dream-put (fn (path handler) (dream-route "PUT" path handler))) (define dream-delete (fn (path handler) (dream-route "DELETE" path handler))) (define dream-patch (fn (path handler) (dream-route "PATCH" path handler))) (define dream-head (fn (path handler) (dream-route "HEAD" path handler))) (define dream-options (fn (path handler) (dream-route "OPTIONS" path handler))) (define dream-any (fn (path handler) (dream-route "ANY" path handler))) ;; ── path segmentation ────────────────────────────────────────────── ;; "/users/42/" -> ("users" "42"); "/" -> () (define dr/segs (fn (path) (filter (fn (s) (not (= s ""))) (split path "/")))) (define dr/join-path (fn (prefix path) (str "/" (join "/" (concat (dr/segs prefix) (dr/segs path)))))) ;; ── segment matching ─────────────────────────────────────────────── ;; Returns a params dict on match (possibly empty {}), nil on no match. (define dr/match-segs (fn (pat path params) (cond ((and (empty? pat) (empty? path)) params) ((empty? pat) nil) (else (let ((ps (first pat))) (cond ((= ps "**") (assoc params "**" (join "/" path))) ((empty? path) nil) ((starts-with? ps ":") (dr/match-segs (rest pat) (rest path) (assoc params (substr ps 1) (first path)))) ((= ps (first path)) (dr/match-segs (rest pat) (rest path) params)) (else nil))))))) (define dr/method-match? (fn (route-method req-method) (or (= route-method "ANY") (= route-method req-method)))) ;; ── middleware pipeline (shared with middleware.sx) ──────────────── ;; m1 @@ m2 @@ handler = (m1 (m2 handler)); first in list is outermost. (define dr/apply-middlewares (fn (mws handler) (reduce (fn (h mw) (mw h)) handler (reverse mws)))) ;; ── scope: prefix mount + middleware chain ───────────────────────── ;; Returns a flat list of routes; nested scopes flatten correctly. (define dr/flatten-routes (fn (items) (reduce (fn (acc it) (if (dream-route? it) (concat acc (list it)) (concat acc (dr/flatten-routes it)))) (list) items))) (define dream-scope (fn (prefix middlewares routes) (map (fn (r) (dream-route (dream-route-method r) (dr/join-path prefix (dream-route-path r)) (dr/apply-middlewares middlewares (dream-route-handler r)))) (dr/flatten-routes routes)))) ;; ── dispatch ─────────────────────────────────────────────────────── (define dr/try-route (fn (r req) (if (dr/method-match? (dream-route-method r) (dream-method req)) (let ((params (dr/match-segs (dr/segs (dream-route-path r)) (dr/segs (dream-path req)) {}))) (if (nil? params) :no-match (dream-coerce-response ((dream-route-handler r) (dream-with-params req params))))) :no-match))) (define dr/dispatch (fn (routes req) (if (empty? routes) (dream-not-found) (let ((res (dr/try-route (first routes) req))) (if (= res :no-match) (dr/dispatch (rest routes) req) res))))) (define dream-router (fn (routes) (let ((flat (dr/flatten-routes routes))) (fn (req) (dr/dispatch flat req)))))