dream: chat (ws rooms) + todo (forms+CSRF) demos + 17 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m2s
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>
This commit is contained in:
46
lib/dream/demos/chat.sx
Normal file
46
lib/dream/demos/chat.sx
Normal file
@@ -0,0 +1,46 @@
|
||||
;; 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)))
|
||||
95
lib/dream/demos/todo.sx
Normal file
95
lib/dream/demos/todo.sx
Normal file
@@ -0,0 +1,95 @@
|
||||
;; lib/dream/demos/todo.sx — CRUD todo list with forms + CSRF (todo.ml).
|
||||
;; An in-memory store holds items; add/toggle/delete go through POST forms guarded
|
||||
;; by the CSRF middleware. Wires session -> csrf -> router.
|
||||
|
||||
(define
|
||||
dream-todo-store
|
||||
(fn () (let ((items (list)) (next-id 0)) {:all (fn () items) :add (fn (text) (begin (set! next-id (+ next-id 1)) (set! items (concat items (list {:id next-id :text text :done false}))) next-id)) :delete (fn (id) (set! items (filter (fn (it) (not (= (get it :id) id))) items))) :toggle (fn (id) (set! items (map (fn (it) (if (= (get it :id) id) (assoc it :done (not (get it :done))) it)) items)))})))
|
||||
|
||||
(define
|
||||
dr/todo-render
|
||||
(fn
|
||||
(store req)
|
||||
(str
|
||||
"<ul>"
|
||||
(reduce
|
||||
(fn
|
||||
(acc it)
|
||||
(str
|
||||
acc
|
||||
"<li>"
|
||||
(if (get it :done) "[x] " "[ ] ")
|
||||
(get it :text)
|
||||
"</li>"))
|
||||
""
|
||||
((get store :all)))
|
||||
"</ul>"
|
||||
"<form method=\"post\" action=\"/add\">"
|
||||
(dream-csrf-tag req)
|
||||
"<input name=\"text\"><button>Add</button></form>")))
|
||||
|
||||
(define
|
||||
dream-todo-index
|
||||
(fn (store) (fn (req) (dream-html (dr/todo-render store req)))))
|
||||
|
||||
(define
|
||||
dream-todo-add
|
||||
(fn
|
||||
(store)
|
||||
(fn
|
||||
(req)
|
||||
(let
|
||||
((r (dream-form req)))
|
||||
(if
|
||||
(dream-ok? r)
|
||||
(begin
|
||||
((get store :add) (get (dream-ok-value r) "text"))
|
||||
(dream-redirect "/"))
|
||||
(dream-html-status
|
||||
403
|
||||
(str "Rejected: " (dream-err-reason r))))))))
|
||||
|
||||
(define
|
||||
dream-todo-toggle
|
||||
(fn
|
||||
(store)
|
||||
(fn
|
||||
(req)
|
||||
(let
|
||||
((r (dream-form req)))
|
||||
(if
|
||||
(dream-ok? r)
|
||||
(begin
|
||||
((get store :toggle) (parse-int (dream-param req "id")))
|
||||
(dream-redirect "/"))
|
||||
(dream-html-status 403 "Rejected"))))))
|
||||
|
||||
(define
|
||||
dream-todo-delete
|
||||
(fn
|
||||
(store)
|
||||
(fn
|
||||
(req)
|
||||
(let
|
||||
((r (dream-form req)))
|
||||
(if
|
||||
(dream-ok? r)
|
||||
(begin
|
||||
((get store :delete) (parse-int (dream-param req "id")))
|
||||
(dream-redirect "/"))
|
||||
(dream-html-status 403 "Rejected"))))))
|
||||
|
||||
(define
|
||||
dream-todo-app-with
|
||||
(fn
|
||||
(store backend secret)
|
||||
((dream-sessions backend)
|
||||
((dream-csrf secret)
|
||||
(dream-router
|
||||
(list
|
||||
(dream-get "/" (dream-todo-index store))
|
||||
(dream-post "/add" (dream-todo-add store))
|
||||
(dream-post "/toggle/:id" (dream-todo-toggle store))
|
||||
(dream-post "/delete/:id" (dream-todo-delete store))))))))
|
||||
|
||||
;; entry: (dream-run (dream-todo-app-with (dream-todo-store) (dream-memory-sessions) "change-me"))
|
||||
Reference in New Issue
Block a user