rose-ash/lib/dream/types.sx

;; lib/dream/types.sx — Dream-on-SX core types.
;; The five types: request, response, route. handler = request->response and
;; middleware = handler->handler are plain SX functions (no records needed).
;; request/response/route are dicts. Headers are dicts with lowercased string
;; keys; keywords are strings in SX, so :content-type == "content-type".

;; ── internal helpers ───────────────────────────────────────────────
(define
  dr/normalize-headers
  (fn
    (h)
    (reduce
      (fn (acc k) (assoc acc (lower k) (get h k)))
      {}
      (keys h))))

(define
  dr/path-of
  (fn
    (target)
    (let
      ((i (index-of target "?")))
      (if (< i 0) target (substr target 0 i)))))

(define
  dr/query-of
  (fn
    (target)
    (let
      ((i (index-of target "?")))
      (if (< i 0) "" (substr target (+ i 1))))))

(define
  dr/parse-pair
  (fn
    (acc pair)
    (if
      (= pair "")
      acc
      (let
        ((j (index-of pair "=")))
        (if
          (< j 0)
          (assoc acc pair "")
          (assoc
            acc
            (substr pair 0 j)
            (substr pair (+ j 1))))))))

(define
  dr/parse-query
  (fn
    (target)
    (let
      ((q (dr/query-of target)))
      (if
        (= q "")
        {}
        (reduce dr/parse-pair {} (split q "&"))))))

;; ── request ────────────────────────────────────────────────────────
(define dream-request (fn (method target headers body) {:path (dr/path-of target) :params {} :query (dr/parse-query target) :body body :headers (dr/normalize-headers headers) :method (upper method) :target target}))

(define
  dream-request?
  (fn (x) (and (dict? x) (has-key? x :method) (has-key? x :path))))
(define dream-method (fn (req) (get req :method)))
(define dream-target (fn (req) (get req :target)))
(define dream-path (fn (req) (get req :path)))
(define dream-body (fn (req) (get req :body)))
(define
  dream-header
  (fn (req name) (get (get req :headers) (lower name))))
(define dream-query-param (fn (req name) (get (get req :query) name)))
(define dream-param (fn (req name) (get (get req :params) name)))
(define dream-params (fn (req) (get req :params)))

;; router fills path params during dispatch
(define
  dream-with-param
  (fn
    (req name val)
    (assoc req :params (assoc (get req :params) name val))))
(define
  dream-with-params
  (fn
    (req more)
    (assoc
      req
      :params (reduce
        (fn (acc k) (assoc acc k (get more k)))
        (get req :params)
        (keys more)))))
(define dream-set-body (fn (req body) (assoc req :body body)))

;; ── request convenience ────────────────────────────────────────────
(define dream-queries (fn (req) (get req :query)))
(define
  dream-query-param-or
  (fn (req name default) (or (dream-query-param req name) default)))
(define dream-has-query? (fn (req name) (has-key? (get req :query) name)))
(define
  dream-header-or
  (fn (req name default) (or (dream-header req name) default)))
(define
  dream-has-header?
  (fn (req name) (has-key? (get req :headers) (lower name))))
(define
  dream-param-or
  (fn (req name default) (or (dream-param req name) default)))
(define dream-has-param? (fn (req name) (has-key? (get req :params) name)))
(define dream-content-type-of (fn (req) (dream-header req "content-type")))
(define dream-method-is? (fn (req m) (= (dream-method req) (upper m))))
(define
  dream-accepts?
  (fn
    (req mime)
    (let
      ((a (dream-header req "accept")))
      (if a (contains? a mime) false))))
(define
  dream-wants-json?
  (fn (req) (dream-accepts? req "application/json")))

;; ── response ───────────────────────────────────────────────────────
(define dream-response (fn (status headers body) {:body body :headers (dr/normalize-headers headers) :status status}))

(define
  dream-response?
  (fn (x) (and (dict? x) (has-key? x :status) (has-key? x :body))))
(define dream-status (fn (resp) (get resp :status)))
(define
  dream-resp-header
  (fn (resp name) (get (get resp :headers) (lower name))))
(define dream-resp-body (fn (resp) (get resp :body)))
(define dream-headers (fn (resp) (get resp :headers)))

(define
  dream-add-header
  (fn
    (resp name val)
    (assoc resp :headers (assoc (get resp :headers) (lower name) val))))
(define dream-set-status (fn (resp status) (assoc resp :status status)))

;; smart constructors
(define dream-html (fn (body) (dream-response 200 {:content-type "text/html; charset=utf-8"} body)))
(define
  dream-html-status
  (fn (status body) (dream-response status {:content-type "text/html; charset=utf-8"} body)))
(define dream-text (fn (body) (dream-response 200 {:content-type "text/plain; charset=utf-8"} body)))
(define dream-json (fn (body) (dream-response 200 {:content-type "application/json"} body)))
(define dream-empty (fn (status) (dream-response status {} "")))
(define
  dream-not-found
  (fn () (dream-response 404 {:content-type "text/plain; charset=utf-8"} "Not Found")))
(define
  dream-redirect
  (fn (location) (dream-response 303 {:location location} "")))
(define
  dream-redirect-status
  (fn (status location) (dream-response status {:location location} "")))

;; coerce a handler result: strings become 200 text/html responses
(define
  dream-coerce-response
  (fn (x) (if (dream-response? x) x (dream-html x))))

;; ── route ──────────────────────────────────────────────────────────
(define dream-route (fn (method path handler) {:path path :handler handler :method (upper method)}))
(define
  dream-route?
  (fn (x) (and (dict? x) (has-key? x :handler) (has-key? x :path))))
(define dream-route-method (fn (r) (get r :method)))
(define dream-route-path (fn (r) (get r :path)))
(define dream-route-handler (fn (r) (get r :handler)))