giles
edff7735e7
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m14s
Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
92 lines
3.1 KiB
Plaintext
92 lines
3.1 KiB
Plaintext
;; lib/dream/flash.sx — Dream-on-SX flash messages.
|
|
;; A single-request cookie store: messages added during one request are read on
|
|
;; the NEXT request, then the cookie is cleared. Depends on types.sx + session.sx
|
|
;; (shared cookie helpers). A message is {:category c :message m}.
|
|
|
|
;; ── cookie codec ───────────────────────────────────────────────────
|
|
;; escape the field separators so categories/messages round-trip safely
|
|
(define
|
|
dr/flash-esc
|
|
(fn (s) (replace (replace (replace s "%" "%25") "|" "%7C") "~" "%7E")))
|
|
(define
|
|
dr/flash-unesc
|
|
(fn (s) (replace (replace (replace s "%7E" "~") "%7C" "|") "%25" "%")))
|
|
|
|
(define
|
|
dr/flash-encode
|
|
(fn
|
|
(msgs)
|
|
(join
|
|
"~"
|
|
(map
|
|
(fn
|
|
(m)
|
|
(str
|
|
(dr/flash-esc (get m :category))
|
|
"|"
|
|
(dr/flash-esc (get m :message))))
|
|
msgs))))
|
|
|
|
(define
|
|
dr/flash-decode
|
|
(fn
|
|
(s)
|
|
(if
|
|
(= s "")
|
|
(list)
|
|
(map
|
|
(fn (part) (let ((i (index-of part "|"))) {:message (dr/flash-unesc (substr part (+ i 1))) :category (dr/flash-unesc (substr part 0 i))}))
|
|
(split s "~")))))
|
|
|
|
;; ── mutable outbox cell ────────────────────────────────────────────
|
|
(define dr/flash-box (fn () (let ((items (list))) {:add (fn (x) (set! items (concat items (list x)))) :get (fn () items)})))
|
|
|
|
;; ── middleware ─────────────────────────────────────────────────────
|
|
(define dream-flash-cookie-name "dream.flash")
|
|
|
|
(define
|
|
dream-flash
|
|
(fn
|
|
(next)
|
|
(fn
|
|
(req)
|
|
(let
|
|
((incoming (dr/flash-decode (or (dream-cookie req dream-flash-cookie-name) "")))
|
|
(box (dr/flash-box)))
|
|
(let
|
|
((resp (next (assoc req :dream-flash {:box box :incoming incoming}))))
|
|
(let
|
|
((out ((get box :get))))
|
|
(cond
|
|
((not (empty? out))
|
|
(dream-set-cookie
|
|
resp
|
|
dream-flash-cookie-name
|
|
(dr/flash-encode out)
|
|
{:path "/" :http-only true :same-site "Lax"}))
|
|
((not (empty? incoming))
|
|
(dream-drop-cookie resp dream-flash-cookie-name))
|
|
(else resp))))))))
|
|
|
|
;; ── handler-facing API ─────────────────────────────────────────────
|
|
(define
|
|
dream-add-flash-message
|
|
(fn
|
|
(req category msg)
|
|
(begin ((get (get (get req :dream-flash) :box) :add) {:message msg :category category}) req)))
|
|
|
|
(define
|
|
dream-flash-messages
|
|
(fn (req) (get (get req :dream-flash) :incoming)))
|
|
(define dream-flash-category (fn (m) (get m :category)))
|
|
(define dream-flash-message (fn (m) (get m :message)))
|
|
|
|
;; convenience: only messages of a given category
|
|
(define
|
|
dream-flash-of
|
|
(fn
|
|
(req category)
|
|
(filter
|
|
(fn (m) (= (get m :category) category))
|
|
(dream-flash-messages req))))
|