giles
b1be3a36ec
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m2s
Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
47 lines
1.5 KiB
Plaintext
47 lines
1.5 KiB
Plaintext
;; lib/dream/demos/chat.sx — multi-room WebSocket chat (chat.ml).
|
|
;; A room registry holds the live connections per room; each ws session joins its
|
|
;; room, broadcasts every received message to the room, and leaves on close.
|
|
|
|
(define dream-chat-rooms (fn () (let ((rooms {})) {:join (fn (room ws) (set! rooms (assoc rooms room (concat (or (get rooms room) (list)) (list ws))))) :broadcast (fn (room msg) (for-each (fn (w) (dream-send w msg)) (or (get rooms room) (list)))) :members (fn (room) (or (get rooms room) (list))) :leave (fn (room ws) (set! rooms (assoc rooms room (filter (fn (w) (not (= w ws))) (or (get rooms room) (list))))))})))
|
|
|
|
(define
|
|
dream-chat-loop
|
|
(fn
|
|
(rooms room ws)
|
|
(let
|
|
((m (dream-receive ws)))
|
|
(if
|
|
(nil? m)
|
|
(begin ((get rooms :leave) room ws) (dream-close ws))
|
|
(begin
|
|
((get rooms :broadcast) room m)
|
|
(dream-chat-loop rooms room ws))))))
|
|
|
|
(define
|
|
dream-chat-session
|
|
(fn
|
|
(rooms room)
|
|
(fn
|
|
(ws)
|
|
(begin ((get rooms :join) room ws) (dream-chat-loop rooms room ws)))))
|
|
|
|
(define
|
|
dream-chat-route
|
|
(fn
|
|
(rooms)
|
|
(fn
|
|
(req)
|
|
((dream-websocket (dream-chat-session rooms (dream-param req "room")))
|
|
req))))
|
|
|
|
(define
|
|
dream-chat-app-with
|
|
(fn
|
|
(rooms)
|
|
(dream-router
|
|
(list
|
|
(dream-get "/" (fn (req) (dream-html "<h1>Rooms</h1>")))
|
|
(dream-get "/chat/:room" (dream-chat-route rooms))))))
|
|
|
|
;; entry point: (dream-run (dream-chat-app-with (dream-chat-rooms)))
|