rose-ash/lib/dream/router.sx

;; 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)))))