ajet/tbd
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

simplify comments
CI / Test + coverage (push) Successful in 1m1s
Details

Browse Source
This commit is contained in:
Adam Jeniski
2026-09-23 03:21:23 -09:00
parent 2637b69c2c
commit d884ca4179
10 changed files with 233 additions and 417 deletions
Download Patch File Download Diff File Expand all files Collapse all files
ui/src/tbd/ui/db.cljs
+19 -39
View File
@@ -2,50 +2,30 @@
(:require [tbd.ui.tictactoe :as tictactoe]))
(def default-db
{;; The page being shown (see tbd.ui.pages); it follows the URL's fragment.
{;; Which page is showing (tbd.ui.pages); follows the URL's fragment.
:page :tic-tac-toe
:calc {:x "" :y ""
;; {:status :idle}
;; {:status :loading}
;; {:status :ok :x "2" :y "3" :sum 5}
;; {:status :error :message "..."}
;; :result is {:status :idle|:loading}, {:status :ok :x :y :sum}, or
;; {:status :error :message}.
:result {:status :idle}}
;; {:status :unknown} (asking /auth/me)
;; {:status :anonymous} (not logged in)
;; {:status :logged-in :login "alice"}
;; {:status :error :message "..."}
;; :user is {:status :unknown}, {:status :anonymous}, {:status :logged-in :login "alice"}, or
;; {:status :error :message}.
:user {:status :unknown}
;; :status is the list load: :idle, :loading, :ok or :error. :error is the message of the
;; last failed request (a load or a change); it is cleared when the next request starts.
:todos {:status :idle
:todos {;; :status is :idle, :loading, :ok or :error; :error is the last failed request's
;; message, cleared when the next request starts.
:status :idle
:items []
:new-title ""
:error nil}
;; The "Add this MCP server to Claude Code" page: :copied? is true right after the
;; command was copied to the clipboard.
;; The "Add this MCP server to Claude Code" page. :copied? is true right after the command was
;; copied to the clipboard.
:mcp {:copied? false}
;; The chat widget (the green square in the corner): :open? is whether its panel is showing,
;; :messages the conversation so far, :input what is typed, :status :idle or :loading (waiting
;; for the reply, or for the tools it asked for), and :error the message of the last failed send.
;; A message is one of
;; {:role "user" :content "..."}
;; {:role "assistant" :content "..."}, with :tool-calls [{:id :name :arguments "{...}"}] when
;; the LLM asked for tools of the page to be called (:content may then be empty), and
;; :thinking "..." with the reasoning behind it, when the model did any (see
;; ::events/chat-event); shown only with "Show reasoning" on.
;; {:role "tool" :tool-call-id "..." :name "..." :content "..." :error? bool}: the result of
;; one such call.
;; :size is what the panel was dragged to, in px: its :width and the :height of the conversation
;; in it (the rest of the panel is the same at any size).
;; :tools-expanded? is whether the tool calls and results show whole (wrapped) or, as they do by
;; default, each cut to one line ending in "…" when it doesn't fit.
;; :reasoning-expanded? is whether each reply's reasoning shows in full, or not at all (the
;; default) — unlike tool use, there is no cut-down middle ground for it.
;; The other three are for a reply that is still coming or being answered: :pending-calls are the
;; calls it has asked for so far, :tool-calls-used how many calls this turn has made, and
;; :tools-used-this-turn the names of the once-per-turn tools (tbd.ui.model-context/once-per-turn-names)
;; it has already run, so the turn can neither offer nor run one of them again.
;; :thinking-at is when (ms since the epoch) the last piece of the model's reasoning came, or nil.
;; The chat widget (the green square). A message is {:role "user"|"assistant"|"tool" :content}
;; with :tool-calls [{:id :name :arguments}] and :thinking on an assistant message that used
;; tools or reasoned, and :tool-call-id/:name on a tool message. :size is the panel's dragged
;; :width/:height. :tools-expanded?/:reasoning-expanded? control whether tool use/reasoning show
;; in full or collapsed. :pending-calls/:tool-calls-used/:tools-used-this-turn/:thinking-at
;; track a reply that is still coming or being answered (see tbd.ui.events).
:chat {:open? false
:size {:width 320 :height 256}
:tools-expanded? false
@@ -55,12 +35,12 @@
:status :idle
:error nil
:pending-calls nil
;; Tool calls the server is still streaming (AG-UI's TOOL_CALL_START/ARGS/END), keyed by
;; toolCallId, until each is complete and moves into :pending-calls.
;; Tool calls still streaming in (AG-UI's TOOL_CALL_START/ARGS/END), keyed by
;; toolCallId, until complete and moved into :pending-calls.
:tool-call-buffer {}
:thinking-at nil
:tool-calls-used 0
:tools-used-this-turn #{}}
;; Tic-tac-toe, entirely client side: the board (see tbd.ui.tictactoe) and whose turn it is.
;; Tic-tac-toe, client side only.
:ttt {:board tictactoe/new-board
:turn :x}})
ui/src/tbd/ui/events.cljs
+102 -184
View File
@@ -8,9 +8,9 @@
[tbd.ui.sse :as sse]
[tbd.ui.tictactoe :as tictactoe]))
;; A `js/fetch` of `uri` (GET unless `method` is given). A `body` is sent as EDN.
;; A `signal` (an AbortSignal) lets the request be aborted.
(defn- fetch-request [{:keys [uri method body signal]}]
(defn- fetch-request
"GETs (or `method`s) `uri`. `body`, if given, is sent as EDN. `signal` (an AbortSignal) aborts it."
[{:keys [uri method body signal]}]
(js/fetch uri (cond-> (clj->js (cond-> {:method (or method "GET")}
body (assoc :headers {"Content-Type" "application/edn"}
:body (pr-str body))))
@@ -19,22 +19,19 @@
(defn- response-map [resp text]
{:ok? (.-ok resp) :status (.-status resp) :body text})
;; Request `uri` (GET unless `method` is given), then dispatch
;; `(conj on-response {:ok? bool :status int-or-nil :body string})`. A `body` is sent as EDN.
;; Network failures come back as `{:ok? false :status nil :body <message>}`.
(defn- do-fetch! [{:keys [on-response] :as request}]
(defn- do-fetch!
"Fetches `request` (see fetch-request), dispatching `(conj on-response {:ok? :status :body})`.
A network failure dispatches `{:ok? false :status nil :body message}`."
[{:keys [on-response] :as request}]
(-> (fetch-request request)
(.then (fn [resp]
(.then (.text resp) #(rf/dispatch (conj on-response (response-map resp %))))))
(.catch #(rf/dispatch (conj on-response {:ok? false :status nil :body (.-message %)})))))
;; Effect: see do-fetch!.
(rf/reg-fx ::fetch do-fetch!)
;; Effect: like ::fetch, for the chat history's own save/clear requests (see save-chat-fx and
;; ::chat-clear) — its own effect id so it never lands in the same bucket as the LLM conversation's
;; requests (tbd.ui.events-test's `requests`/`last-request` are built on ::fetch/::fetch-stream
;; alone, and would otherwise sometimes see this request instead of the one a test is waiting for).
;; Same as ::fetch, with its own id so chat-history saves don't collide with the chat stream's
;; requests in tests.
(rf/reg-fx ::persist-chat do-fetch!)
(def ^:private connection-lost {:type "RUN_ERROR" :message "the connection was lost"})
@@ -44,11 +41,9 @@
#{"RUN_FINISHED" "RUN_ERROR"})
(defn- read-events!
"Dispatches `(conj on-event event)` for each AG-UI event (see tbd.ui.sse, tbd.chat.routes) in the
body read by `reader`, as they arrive. A body that ends without a RUN_FINISHED or RUN_ERROR event
(the connection dropped) is a RUN_ERROR event of its own, so whoever waits for the end always
gets one — unless `signal` was aborted (see ::abort-stream): then nothing more is dispatched at
all, since whoever aborted it has stopped waiting, and may have started another stream since."
"Dispatches `(conj on-event event)` for each AG-UI event decoded from `reader`, as it arrives. A
stream that ends without a RUN_FINISHED/RUN_ERROR event dispatches a RUN_ERROR of its own — unless
`signal` was aborted, in which case nothing more is dispatched."
[reader on-event ^js signal]
(let [decoder (js/TextDecoder. "utf-8")
ended? (atom false)
@@ -72,15 +67,12 @@
(.catch (fn [_] (lost!)))))]
(step "")))
;; The AbortController of the stream ::fetch-stream last started, for ::abort-stream. There is only
;; ever one in flight (the chat sends one message at a time).
;; The in-flight stream's AbortController, for ::abort-stream. Only one stream runs at a time.
(defonce ^:private stream-controller (atom nil))
;; Effect: like ::fetch, for a response that is a stream of server-sent events. While it comes in,
;; `(conj on-event event)` is dispatched for each event, as a map (see read-events!). When the
;; request fails instead (a network error or a status that isn't 2xx: no stream came),
;; `(conj on-response {:ok? false :status int-or-nil :body string})` is dispatched, as ::fetch does.
;; After ::abort-stream, nothing more is dispatched for it.
;; Like ::fetch, for a streamed response: dispatches `(conj on-event event)` for each event as it
;; arrives (see read-events!), or `(conj on-response {:ok? false ...})` if the request itself fails.
;; Nothing more is dispatched once ::abort-stream has run.
(rf/reg-fx
::fetch-stream
(fn [{:keys [on-event on-response] :as request}]
@@ -95,8 +87,8 @@
(.then (.text resp) #(respond! (response-map resp %))))))
(.catch #(respond! {:ok? false :status nil :body (.-message %)}))))))
;; Effect: abort the stream ::fetch-stream last started, if it is still going. The connection
;; closing is what tells the server to stop the LLM (see tbd.chat.routes/event-stream).
;; Aborts the in-flight stream, if any. Closing the connection is what tells the server to stop
;; the LLM (see tbd.chat.routes/event-stream).
(rf/reg-fx
::abort-stream
(fn [_]
@@ -104,24 +96,20 @@
(reset! stream-controller nil)
(.abort controller))))
;; Coeffect: the URL's fragment, which says which page to start on.
;; The URL's fragment, which says which page to start on.
(rf/reg-cofx
::hash
(fn [cofx _]
(assoc cofx :hash js/location.hash)))
;; Coeffect: the time now, in ms since the epoch.
(rf/reg-cofx
::now
(fn [cofx _]
(assoc cofx :now (js/Date.now))))
;; localStorage key the chat widget's :open? and :size are kept under (see ::persist-chat-ui and
;; ::initialize), so a reload leaves the panel showing (or hidden) and sized as it was left.
(def ^:private chat-ui-storage-key "tbd.chat-ui")
;; Coeffect: the chat widget's :open? and :size as they were last left, or nil if nothing was ever
;; saved (or what's there can't be read, e.g. it was hand-edited into garbage).
;; The chat widget's saved :open?/:size, or nil if there is none (or it's unreadable).
(rf/reg-cofx
::chat-ui-storage
(fn [cofx _]
@@ -132,18 +120,14 @@
(select-keys [:open? :size]))
(catch :default _ nil)))))
;; Effect: remembers the chat widget's :open? and :size in localStorage, across reloads.
(rf/reg-fx
::persist-chat-ui
(fn [chat-ui]
(.setItem js/localStorage chat-ui-storage-key (pr-str chat-ui))))
;; localStorage key the tic-tac-toe board and whose turn it is are kept under (see ::persist-ttt
;; and ::initialize), so a reload finds the game as it was left instead of starting over.
(def ^:private ttt-storage-key "tbd.ttt")
;; Coeffect: the tic-tac-toe :board and :turn as they were last left, or nil if nothing was ever
;; saved (or what's there can't be read, e.g. it was hand-edited into garbage).
;; The tic-tac-toe :board/:turn as last saved, or nil.
(rf/reg-cofx
::ttt-storage
(fn [cofx _]
@@ -154,14 +138,13 @@
(select-keys [:board :turn]))
(catch :default _ nil)))))
;; Effect: remembers the tic-tac-toe :board and :turn in localStorage, across reloads.
(rf/reg-fx
::persist-ttt
(fn [ttt]
(.setItem js/localStorage ttt-storage-key (pr-str ttt))))
;; Effect: show the page the URL names whenever it changes (a link was followed, or Back and
;; Forward were pressed). Only one listener is ever installed, however often this runs.
;; Shows the page named by the URL whenever it changes (a link, or Back/Forward). Installs at
;; most one listener, however often this runs.
(defonce ^:private hash-listener (atom nil))
(rf/reg-fx
@@ -172,7 +155,6 @@
(reset! hash-listener #(rf/dispatch [::hash-changed js/location.hash]))
(.addEventListener js/window "hashchange" @hash-listener)))
;; Effect: put `hash` in the URL, which is how a page gets its own address (and a Back button).
(rf/reg-fx
::set-hash
(fn [hash]
@@ -190,14 +172,12 @@
;; --- Pages ---
;; The URL changed (a link was followed, or Back was pressed): show the page it names.
(rf/reg-event-db
::hash-changed
(fn [db [_ hash]]
(assoc db :page (pages/hash->page hash))))
;; Go to a page without a link, as the browser tools do. The page changes right away; the URL
;; follows, and its change event finds the page already shown.
;; Navigates without a link: the page changes right away, and the URL follows.
(rf/reg-event-fx
::navigate
(fn [{:keys [db]} [_ page]]
@@ -259,7 +239,7 @@
{::fetch {:uri "/auth/logout" :method "POST" :on-response [::logout-response]}}))
(defn- reset-chat
"An empty conversation, in a panel that is as open (or closed), and as big, as it was."
"An empty conversation, keeping the panel's :open?/:size/:tools-expanded?/:reasoning-expanded?."
[db]
(assoc db :chat (merge (:chat db/default-db)
(select-keys (:chat db) [:open? :size :tools-expanded? :reasoning-expanded?]))))
@@ -291,8 +271,8 @@
(update db :todos assoc :status :ok :items (:todos (reader/read-string body)))
(update db :todos assoc :status :error :error (error-message resp)))))
;; A failed change keeps the list as it is and shows the message. A 401 means the session
;; expired, so fall back to the logged-out view (which hides the todos).
;; A 401 means the session expired: fall back to the logged-out view. Otherwise the list stays,
;; with the error shown.
(rf/reg-event-db
::todo-failed
(fn [db [_ {:keys [status] :as resp}]]
@@ -356,39 +336,34 @@
;; --- Chat ---
;; The chat is a loop when the LLM uses the page's tools (see tbd.ui.model-context): the reply to a
;; message can be a request for tool calls instead of (or after) text; the page makes the calls,
;; and sends the conversation again, now with their results, for the LLM to go on from. It does
;; that until the LLM answers without asking for tools.
;; The chat loops when the LLM calls tools of the page (tbd.ui.model-context): the page runs them
;; and resends the conversation, until the LLM answers without asking for more.
(def ^:private max-sent-messages
"How much of the conversation goes to the server with each message (its limit is
tbd.chat.schema/max-messages, which this stays within), the most recent part."
"How much of the conversation goes to the server per request (bounded by
tbd.chat.schema/max-messages), the most recent part."
40)
(def ^:private max-tool-calls-per-turn
"How many tool calls the LLM may make in answer to one message of the user's, before the page
stops it. A model that keeps calling tools never answers, and every call is something done on the
user's page. (A turn is at most 1 + this many assistant messages and this many results, so it is
always inside `max-sent-messages`.)"
"Max tool calls the LLM may make answering one message, before the turn is stopped as a runaway
loop. (A turn is at most 1 + this many assistant messages and this many results, so it always
stays within max-sent-messages.)"
12)
(def ^:private max-tool-result-length
"The longest result of a tool that goes to the LLM (tbd.chat.schema/max-message-length)."
"The longest tool result sent to the LLM (tbd.chat.schema/max-message-length)."
8000)
(def ^:private truncated " … (truncated)")
(defn- display-text
"A tool's result text as kept in memory and shown in the chat log: never empty. Not cut down —
the browser keeps the whole thing for as long as the tab is open, so \"Expand tool use\" has
something to expand to; only what leaves the tab (to the LLM, or to /api/chat/history) is fit to
the server's limit, by `fit-result`."
"`text` for the chat log, never empty. Kept in full here; only what leaves the tab is cut down,
by fit-result."
[text]
(if (str/blank? text) "(no output)" text))
(defn- fit-result
"`text`, no longer than the server takes, for a tool result about to leave the tab."
"`text`, cut to max-tool-result-length, for a tool result about to leave the tab."
[text]
(if (> (count text) max-tool-result-length)
(str (subs text 0 (- max-tool-result-length (count truncated))) truncated)
@@ -397,15 +372,13 @@
(defonce ^:private id-counter (atom 0))
(defn- next-id
"An id unique within this page's session, for an AG-UI message: they only have to identify a
message within one run's conversation, never across page loads."
"A fresh id for an AG-UI message, unique within this page's session."
[]
(str "m" (swap! id-counter inc)))
(defn- wire-message
"A message of the conversation as AG-UI's Message has it (see tbd.chat.schema/Message: user,
assistant with `toolCalls`, or tool). A tool result is fit to the server's limit here, on the
way out — the browser's own copy, in `db`, stays whole."
"A conversation message as AG-UI's Message (tbd.chat.schema/Message). A tool result is fit to
the server's limit here; the browser's own copy stays whole."
[{:keys [role content tool-calls tool-call-id]}]
(cond-> {:id (next-id) :role role}
(= "tool" role) (assoc :toolCallId tool-call-id :content (fit-result content))
@@ -416,51 +389,41 @@
tool-calls))))
(defn- windowed
"The most recent `n` of `messages`, without the results of calls whose asking is cut off: a
result stranded at the front, its call dropped, answers nothing."
"The most recent `n` of `messages`, dropping a leading tool result whose call fell out of the
window."
[n messages]
(drop-while #(= "tool" (:role %)) (take-last n messages)))
(defn- recent
"The most recent `max-sent-messages` of `messages`, without the results of calls whose asking
is cut off: the LLM server refuses a result that answers nothing."
[messages]
(defn- recent [messages]
(windowed max-sent-messages messages))
(def ^:private max-stored-messages
"How much of the conversation is saved for the \"restore my last session\" feature
(tbd.chat.schema/max-history-messages, which this stays within): more than max-sent-messages,
since this is scrollback for the user to read, not context sent to the LLM."
"How much of the conversation is saved for \"restore my last session\" (bounded by
tbd.chat.schema/max-history-messages): more than max-sent-messages, since this is scrollback."
100)
(def ^:private max-stored-content-length
"The longest tool result, or reply's reasoning, that is saved
(tbd.chat.schema/max-history-content-length): the saved conversation is the whole log, for
\"Expand tool use\"/\"Show reasoning\" to show after a reload, so it is not cut down to what the
LLM is sent."
"The longest tool result or reasoning kept in a saved conversation
(tbd.chat.schema/max-history-content-length): the full log, for \"Expand\"/\"Show reasoning\"
after a reload, not cut to what the LLM sees."
100000)
(def ^:private max-stored-length
"How long the saved conversation may be, printed, all told (tbd.chat.schema/max-history-length)."
"Total length of a saved conversation, printed (tbd.chat.schema/max-history-length)."
1000000)
(declare only-reasoning?)
(defn- fit-stored
"`text`, no longer than /api/chat/history takes for a tool result or reasoning."
[text]
(defn- fit-stored [text]
(if (> (count text) max-stored-content-length)
(str (subs text 0 (- max-stored-content-length (count truncated))) truncated)
text))
(defn- storable
"The most recent `max-stored-messages` of `messages`, as /api/chat/history's PUT wants them: the
browser's own internal shape (see tbd.ui.db), not AG-UI's wire Message — that endpoint is this
app's own addition, not part of an AG-UI run, so nothing is lost translating to and from it.
Tool results and reasoning are saved whole (up to `max-stored-content-length`), not fit to what
the LLM is sent, so a reload restores the full log; when the whole is over `max-stored-length`,
the oldest turns go instead. A reply halted before it said anything (see ::chat-halt) isn't
saved: the server keeps no message that says nothing."
"The most recent `max-stored-messages` of `messages`, as /api/chat/history's PUT wants them.
Drops replies that came to nothing but reasoning, and fits tool results/reasoning to
max-stored-content-length. If the total is still over max-stored-length, drops whole oldest
turns (never a result without its call, or a reply without its question)."
[messages]
(let [fitted (into []
(comp (remove only-reasoning?)
@@ -474,15 +437,12 @@
size (reduce + 2 sizes)
sizes sizes]
(if (and (> size max-stored-length) (seq messages))
;; The oldest turn goes whole, up to the next message of the user's: nothing is left
;; stranded, a result without its call or a reply without its question.
(let [n (inc (count (take-while #(not= "user" (:role %)) (rest messages))))]
(recur (subvec messages n) (- size (reduce + (take n sizes))) (subvec sizes n)))
messages))))
;; Effect: best-effort save of the conversation so far, for /api/chat/history to hand back on the
;; next login. Never blocks anything: on failure the next natural save point (the next message
;; sent, or the turn after) tries again with the conversation as it is by then.
;; Best-effort save of the conversation for /api/chat/history to hand back on next login. Never
;; blocks anything: a failure is retried at the next natural save point.
(defn- save-chat-fx [db]
{:uri "/api/chat/history" :method "PUT"
:body {:messages (storable (get-in db [:chat :messages]))}
@@ -491,35 +451,26 @@
(rf/reg-event-db
::save-chat-history-response
(fn [db [_ {:keys [status]}]]
;; A 401 means the session expired since the save was sent; anything else is a transient
;; failure the next save point papers over, so there is nothing to do for it.
(if (= 401 status)
(-> db (assoc :user {:status :anonymous}) reset-chat)
db)))
(defn- wire-tool
"A tool as AG-UI's Tool has it (see tbd.chat.schema/Tool): `parameters`, not MCP's `inputSchema`."
"A tool as AG-UI's Tool has it (tbd.chat.schema/Tool): `parameters`, not MCP's `inputSchema`."
[{:keys [name description inputSchema]}]
(cond-> {:name name :parameters inputSchema}
description (assoc :description description)))
;; The request that sends the conversation: an AG-UI RunAgentInput. It goes with the page being
;; shown (as a `context` entry, for the LLM to know where the user is), the tools that page offers
;; the LLM, and its current state (`state`, see tbd.ui.model-context/current-state and
;; tbd.chat.schema/RunAgentInput) — what a read-only tool would have told it, so it never has to
;; spend a call finding out. All three are read from the db every time, so a conversation that
;; moves between pages (the LLM's own `navigate`, say) always tells the LLM where it is now. Old
;; tool results are sent as they are (nothing here marks them stale): the state is always
;; refreshed and current, and the system prompt tells the model to go by that over anything said
;; earlier, so there is nothing an old result could mislead it into believing.
;; An AG-UI RunAgentInput: the page's name (as `context`, so the LLM knows where the user is), the
;; tools that page offers, and its current state (model-context/current-state), so the LLM never
;; has to spend a call finding out. Read from the db each time, so a conversation that moves
;; between pages always reflects where it is now.
(defn- chat-request [db messages]
(let [page (:page db)
once (model-context/once-per-turn-names page)
used (get-in db [:chat :tools-used-this-turn])
tools (remove (comp #(and (once %) (used %)) :name) (model-context/definitions page))
state (model-context/current-state page)
;; A reply halted (see ::chat-halt) before it said anything stays on screen, with whatever
;; reasoning it had, but there is nothing in it for the LLM (which refuses it).
messages (remove only-reasoning? messages)]
{:uri "/api/chat" :method "POST"
:body (cond-> {:threadId (next-id) :runId (next-id)
@@ -530,9 +481,8 @@
:on-event [::chat-event]
:on-response [::chat-response]}))
;; Restoring the last session: fetched once, right after login (see ::user-response), and merged
;; in only if nothing has been said in this page load yet — a slow response landing after the user
;; already started a fresh conversation would otherwise stomp on it.
;; Restores the last session, right after login. Merged in only if nothing has been said in this
;; page load yet, so a slow response can't stomp on a conversation already started.
(rf/reg-event-fx
::load-chat-history
(fn [_ _]
@@ -545,8 +495,6 @@
(assoc-in db [:chat :messages] (:messages (reader/read-string body)))
db)))
;; Whether the chat widget is open persists (see ::persist-chat-ui) so a reload leaves it as the
;; user left it.
(rf/reg-event-fx
::chat-toggle
(fn [{:keys [db]} _]
@@ -554,8 +502,6 @@
{:db db
::persist-chat-ui (select-keys (:chat db) [:open? :size])})))
;; The panel is dragged to `width` px wide and its conversation `height` px high (the view keeps
;; them within the window). The size persists (see ::persist-chat-ui) so a reload keeps it.
(rf/reg-event-fx
::chat-resize
(fn [{:keys [db]} [_ width height]]
@@ -563,13 +509,11 @@
{:db db
::persist-chat-ui (select-keys (:chat db) [:open? :size])})))
;; Whether the tool calls and results show whole, or each cut to one line.
(rf/reg-event-db
::chat-toggle-tools
(fn [db _]
(update-in db [:chat :tools-expanded?] not)))
;; Whether each reply's reasoning shows in full, or not at all.
(rf/reg-event-db
::chat-toggle-reasoning
(fn [db _]
@@ -580,7 +524,6 @@
(fn [db [_ input]]
(assoc-in db [:chat :input] input)))
;; Only one message is in flight at a time, and a blank one isn't sent.
(rf/reg-event-fx
::chat-send
(fn [{:keys [db]} _]
@@ -595,18 +538,15 @@
::persist-chat (save-chat-fx db)})))))
(defn- only-reasoning?
"Whether `message` is a reply that has come to nothing but the reasoning for it: there is nothing
in it for the LLM to be sent (the server refuses an assistant message that says and asks for
nothing)."
"Whether `message` is a reply that has come to nothing but reasoning: no content, no tool calls
(the server refuses a message that says and asks for nothing)."
[{:keys [role content tool-calls]}]
(and (= "assistant" role) (str/blank? content) (empty? tool-calls)))
(defn- chat-failed
"The conversation after a send failed with `message`. If the last message is the user's (nothing
of the reply had come, but perhaps some reasoning, which goes), it leaves the conversation again
and goes back in the input, so trying once more is pressing Send (and the next message doesn't
follow one nobody answered). If part of the reply had come, or the tools' results had been sent,
that stays, and the next message follows it."
"The conversation after a send failed with `message`. If nothing of the reply had come, the
unanswered user message goes back into the input (so retrying is just pressing Send); otherwise
whatever came stays, and the next message follows it."
[db message]
(let [messages (get-in db [:chat :messages])
messages (cond-> messages (only-reasoning? (peek messages)) pop)
@@ -616,9 +556,8 @@
(when unanswered?
{:messages (pop messages) :input (:content (peek messages))}))))
;; The server answered without a stream: the request failed. A 401 means the session expired: fall
;; back to the logged-out view. A response nobody is waiting for (the conversation was reset since,
;; by logging out) is dropped.
;; The server answered without a stream: the request failed. A 401 means the session expired.
;; A response nobody is waiting for (the conversation was reset since) is dropped.
(rf/reg-event-fx
::chat-response
(fn [{:keys [db]} [_ {:keys [status] :as resp}]]
@@ -629,10 +568,9 @@
{:db db ::persist-chat (save-chat-fx db)}))))
(defn- append-to-reply
"The conversation's assistant message being written, with `text` added to its content. The first
piece starts the message, the rest are added to it. Leading whitespace is dropped while nothing
has been said yet (the model often opens its answer with a stray blank line right after
reasoning), but preserved once the message has content, since it may be meaningful there."
"The conversation with `text` added to the assistant message being written (starting one if
needed). Leading whitespace is dropped until the message has content (a reasoning model often
opens with a stray blank line), then preserved."
[db text]
(update-in db [:chat :messages]
(fn [messages]
@@ -643,9 +581,8 @@
(conj messages {:role "assistant" :content (str/triml text)})))))
(defn- append-reasoning
"The conversation's assistant message being written, with `text` added to its reasoning — kept
apart from `:content` (see append-to-reply) so \"Show reasoning\" can reveal it, in full, for
whichever reply it belongs to; hidden otherwise."
"Like append-to-reply, but onto :thinking, kept apart from :content so \"Show reasoning\" can
reveal it for the right reply."
[db text]
(update-in db [:chat :messages]
(fn [messages]
@@ -654,8 +591,8 @@
(conj messages {:role "assistant" :content "" :thinking text})))))
(defn- with-tool-calls
"The conversation with the calls the LLM asked for: on the reply's text (the message it
started), or on a message of their own when it said nothing."
"The conversation with `calls` attached to the reply (on its text, or a fresh message if it said
nothing)."
[messages calls]
(if (= "assistant" (:role (peek messages)))
(update messages (dec (count messages)) assoc :tool-calls calls)
@@ -665,10 +602,8 @@
{:role "tool" :tool-call-id id :name name :content content :error? (boolean error?)})
(defn- blocked-calls
"`calls`, each marked `:blocked?` when it names a tool in `once` (see
tbd.ui.model-context/once-per-turn-names) that `used` (the names already spent earlier this
turn) already has, or an earlier call of this same batch does — the model asking twice in one
reply is blocked exactly like asking again after the results of the first came back."
"`calls`, each marked `:blocked?` when it names a once-per-turn tool (model-context/once-per-turn-names)
already used this turn, or by an earlier call in this same batch."
[once used calls]
(first (reduce (fn [[marked seen] {:keys [name] :as call}]
(let [counts? (once name)]
@@ -677,10 +612,9 @@
[[] #{}] calls)))
(defn- finish-reply
"The reply is complete. Without calls that is all; with them, they are made (see ::call-tools) —
except a call to a once-per-turn tool already spent this turn (`blocked-calls`), which is
refused without running — and the conversation goes on when they are done, unless this turn has
used all the calls it may."
"The reply is complete. With no calls, that's it. With calls, runs them (::call-tools) — except
blocked ones (blocked-calls), refused without running — unless this turn has already used all
its tool calls (max-tool-calls-per-turn), in which case the turn is stopped instead."
[db]
(let [{:keys [pending-calls tool-calls-used]} (:chat db)
used (+ (or tool-calls-used 0) (count pending-calls))
@@ -695,7 +629,6 @@
{:db db ::persist-chat (save-chat-fx db)})
(> used max-tool-calls-per-turn)
;; The calls still get their answers, for the conversation to make sense to the LLM later.
(let [db (-> db
(update-in [:chat :messages] with-tool-calls pending-calls)
(update-in [:chat :messages] into
@@ -728,15 +661,10 @@
call (-> (update-in [:chat :pending-calls] (fnil conj []) call)
(update-in [:chat :tool-call-buffer] dissoc toolCallId)))))
;; One AG-UI event of the reply (see tbd.chat.routes, https://docs.ag-ui.com): TEXT_MESSAGE_CONTENT
;; ({:delta "..."}) for the next piece of the reply (the first starts the assistant's message, the
;; rest are added to it), REASONING_MESSAGE_CONTENT for the next piece of the model's reasoning
;; (added to that same message's own :thinking, apart from :content — see append-reasoning; the
;; user only sees "Thinking…" while it comes in, and, if "Show reasoning" is on, the whole of it
;; once it's there; while it's still coming, :thinking-at, the time the last piece came, is for
;; that), TOOL_CALL_START/TOOL_CALL_ARGS/TOOL_CALL_END as it asks for tools to be called
;; (accumulated in :tool-call-buffer until each call is complete), and last RUN_FINISHED or
;; RUN_ERROR. Events nobody is waiting for (the conversation was reset since) are dropped.
;; One AG-UI event of the reply (tbd.chat.routes, https://docs.ag-ui.com): TEXT_MESSAGE_CONTENT
;; and REASONING_MESSAGE_CONTENT append to the reply's :content/:thinking, TOOL_CALL_START/ARGS/END
;; build up :tool-call-buffer, and RUN_FINISHED/RUN_ERROR end the turn. Events nobody is waiting
;; for (the conversation was reset since) are dropped.
(rf/reg-event-fx
::chat-event
[(rf/inject-cofx ::now)]
@@ -759,14 +687,12 @@
:else {:db db}))))
(def ^:private blocked-message
"The result of a call `blocked-calls` marked: a once-per-turn tool, already spent this turn."
"not run: this only runs once per message, and already has this turn — answer instead of calling it again")
(defn- call-all
"A promise of the results of `calls`, in order, as {:id :name :content :error?}. One after the
other: the tools work on the same page (one may need the page the last one opened). Only the
tools `page` offers can be called; a call `finish-reply` marked `:blocked?` (see `blocked-calls`)
never reaches the page at all."
"A promise of the results of `calls`, in order, as {:id :name :content :error?}. Run one after
the other (a tool may need the page the last one left). A call marked :blocked? by blocked-calls
never reaches the page."
[page calls]
(reduce (fn [results {:keys [id name arguments blocked?]}]
(.then results
@@ -779,25 +705,23 @@
(js/Promise.resolve [])
calls))
;; Effect: make the tool calls the LLM asked for, on the tools `page` (the one being shown) offers,
;; and dispatch `(conj on-results results)` when all are done: one {:id :name :content :error?}
;; for each, in order. A call that can't be made (an unknown tool, one the page doesn't offer,
;; arguments that aren't JSON, a tool that fails) is a result with :error?, for the LLM to read.
;; Runs the LLM's tool calls on `page`'s tools, and dispatches `(conj on-results results)` when
;; done: one {:id :name :content :error?} per call. A call that can't be made (unknown tool, bad
;; arguments, a tool that throws) comes back as an :error? result, for the LLM to read.
(rf/reg-fx
::call-tools
(fn [{:keys [page calls on-results]}]
(.then (call-all page calls) #(rf/dispatch (conj on-results %)))))
(defn- answers?
"Whether `results` are for the calls the conversation is waiting on. Results nobody waits for
(the conversation was reset while the tools ran) are not."
"Whether `results` answer the calls the conversation is waiting on (not a stale response after
the conversation was reset while the tools ran)."
[db results]
(let [calls (:tool-calls (peek (get-in db [:chat :messages])))]
(and (= :loading (get-in db [:chat :status]))
(seq calls)
(= (map :id calls) (map :id results)))))
;; The tools have run: their results join the conversation, and it goes to the LLM again.
(rf/reg-event-fx
::chat-tool-results
(fn [{:keys [db]} [_ results]]
@@ -807,14 +731,11 @@
{:db db
::fetch-stream (chat-request db (get-in db [:chat :messages]))}))))
;; The user halts the reply mid-way, to steer it with their next message: the stream stops (and the
;; LLM with it, see ::abort-stream), and what has come of the reply so far stays, marked :halted? —
;; its reasoning and words, but not tool calls it was still asking for, which are never made. If
;; the tools it asked for are running, their results no longer go to the LLM (see answers?); each
;; is answered with `halted-result` instead, since the LLM refuses a call left unanswered.
(def ^:private halted-result
"(halted by the user before the result came back: this call may or may not have taken effect)")
;; Marks the reply :halted? and answers any in-flight tool calls with halted-result, since the LLM
;; refuses a call left unanswered.
(defn- halt-reply [messages]
(let [{:keys [role tool-calls]} (peek messages)]
(cond
@@ -828,6 +749,8 @@
:else (update messages (dec (count messages)) assoc :halted? true))))
;; The user halts a reply mid-way, to steer it with the next message: stops the stream
;; (::abort-stream), and marks what came so far :halted? (see halt-reply) instead of discarding it.
(rf/reg-event-fx
::chat-halt
(fn [{:keys [db]} _]
@@ -841,8 +764,7 @@
::abort-stream true
::persist-chat (save-chat-fx db)}))))
;; Starts a new session: not while a reply is on its way (it would land in the new one), and the
;; stored history goes with it, so a reload doesn't bring the old conversation back.
;; Starts a new session (not while a reply is in flight), clearing the stored history too.
(rf/reg-event-fx
::chat-clear
(fn [{:keys [db]} _]
@@ -853,14 +775,12 @@
(rf/reg-event-db
::clear-chat-history-response
;; Best-effort: a failure here just means the old session may come back on the next reload,
;; which the next successful save (or clear) fixes.
(fn [db _] db))
;; --- MCP setup page ---
;; Effect: put `text` on the clipboard. The Clipboard API only exists on secure origins (https
;; or localhost), so the view doesn't offer the button without it; failures are ignored.
;; Puts `text` on the clipboard. Requires a secure origin (https or localhost); failures are
;; ignored.
(rf/reg-fx
::copy-to-clipboard
(fn [text]
@@ -880,8 +800,6 @@
;; --- Tic-tac-toe ---
;; An illegal move (taken cell, game over) changes nothing. The board persists (see ::persist-ttt)
;; so a reload finds the game where it was left.
(rf/reg-event-fx
::ttt-move
(fn [{:keys [db]} [_ i]]
ui/src/tbd/ui/model_context.cljs
+10 -24
View File
@@ -1,30 +1,16 @@
(ns tbd.ui.model-context
"The page's `modelContext`: the tools the page offers to an agent, as WebMCP names it (a page
registers tools with `navigator.modelContext` in the browsers that have one). Here it is the
registry the page's own chatbot reads. tbd.ui.core registers the tools of tbd.ui.webmcp, which
are also offered to an outside agent through the WebMCP widget; the chatbot is the same thing
embedded in the page.
"The registry of tools the page's own chatbot offers its LLM, mirroring WebMCP's
`navigator.modelContext` (tbd.ui.core registers tbd.ui.webmcp's tools here too). The chatbot
sends `definitions` (MCP's `tools/list` shape) with the conversation; tbd.ui.events intercepts
the LLM's requested calls and runs them via `call!`, right here in the page.
The chatbot passes the tools' metadata (`definitions`, the shape of MCP's `tools/list`) to the
LLM along with the conversation. The LLM never runs anything: it answers with the calls it wants
made, tbd.ui.events intercepts them, `call!` invokes the tool right here in the page (the same
handlers as WebMCP's, so it shows on screen like a user's own doing) and the result goes back to
the LLM with the next request, as MCP's `tools/call` result would.
A tool is {:name :description :input-schema :handler :pages}. `handler` takes a map of
arguments and returns a value or promise of one (a string as-is, other data as JSON; throwing is
an error result). `pages` (tbd.ui.pages) is where the tool is offered; omitted means every page.
A tool is {:name :description :input-schema :handler :pages}: `handler` takes its arguments as a
map and returns a value or a promise of one. A string is the result as it is, any other data
becomes JSON, and throwing (or rejecting) is an error result the agent can read. `pages` is the
set of pages (see tbd.ui.pages) the tool is offered on, so the LLM on the tic-tac-toe page is not
handed the todos' tools; a tool without it is offered on every page. What is offered follows the
page being shown: `definitions` and `call!` both take it, and a tool that is not offered on it
can neither be listed nor called.
Besides tools, the page registers state providers: {:pages :provide}, `provide` a plain function
of no arguments returning the page's current state as a map (`pages` means the same as a tool's).
tbd.ui.events attaches `(current-state page)` to every /api/chat request (see
tbd.chat.schema/RunAgentInput's `state`), so the model has what the page shows already, without
spending a tool call to read it — tbd.ui.webmcp's `state-providers` is where these live, since
they need `db`, and it already requires this ns for the tools."
State providers ({:pages :provide}) are the same idea for ambient state: tbd.ui.events attaches
`(current-state page)` to every /api/chat request (tbd.chat.schema/RunAgentInput's `state`), so
the model sees what the page shows without spending a call to read it."
(:require [clojure.string :as str]))
(defonce ^:private registry (atom []))
ui/src/tbd/ui/views.cljs
+3 -6
View File
@@ -179,12 +179,9 @@
(def ^:private chat-green "#28a745")
;; What Markdown blocks (tbd.ui.markdown) look like inside a bubble: :white-space "pre-wrap" (the
;; bubble's old way of keeping line breaks without any markup) is gone, since the hiccup now
;; carries its own paragraphs, lists and code blocks; this fills in the spacing and borders
;; browsers don't give those elements by default, and a low-alpha black overlay for code and
;; rules, which reads on both the green and the grey bubble. Global, not scoped to one bubble,
;; but "chat-markdown" is specific enough not to collide with anything else on the page.
;; Spacing/border defaults for Markdown blocks (tbd.ui.markdown) inside a bubble, plus a low-alpha
;; overlay for code/rules that reads on both the green and grey bubble colors. Global (not scoped
;; to one bubble), but "chat-markdown" is specific enough not to collide with the rest of the page.
(defn- chat-markdown-style []
[:style "
.chat-markdown > :first-child { margin-top: 0; }
ui/src/tbd/ui/webmcp.cljs
+11 -31
View File
@@ -1,33 +1,18 @@
(ns tbd.ui.webmcp
"The page's own MCP tools, for an agent running in the browser: the client-side counterpart of
tbd.mcp.tools. They are offered through WebMCP (https://webmcp.dev, the `@jason.today/webmcp`
library): it adds a small widget to the page, the user pastes a token from their MCP client
(Claude) into it, and the client then sees the tools registered here. Where tbd.mcp.tools works
on the server's data, these work the UI: each one does what a user could do on the page (type in
the form, press a button, tick a box) by dispatching the same re-frame events the views do, so
everything shows on screen, and reads what the page shows from the app-db.
tbd.mcp.tools, offered through WebMCP (https://webmcp.dev). Each tool does what a user could do
on the page (type in a form, press a button) by dispatching the same re-frame events the views
do, and reads results from the app-db. A tool takes a map of arguments and returns a value or a
promise of one (a string, or data that becomes JSON); throwing becomes an error result.
Besides the tools, the page registers prompts and resources (`prompts`, `resources`), which is
what an MCP client lists next to the tools (Claude Code shows the prompts as slash commands and
the resources as @-mentions). They are the same instructions the page's own chatbot is given
(tbd.agent.prompt, shared with the server), so Claude or Codex is told to act rather than offer,
to chain calls, and can read what page is open.
`tools` also feeds tbd.ui.model-context (via tbd.ui.core), which offers the page's chatbot the
same tools. `:read-only? true` tools are left out there — the chatbot gets that information as
ambient state instead (`state-providers`) — but stay registered here for WebMCP's outside
agents. `:once-per-turn? true` tools (e.g. move_tic_tac_toe) are offered to the chatbot only
until used once per turn (tbd.ui.events); that cap doesn't apply to WebMCP's outside agents.
The same tools are registered with tbd.ui.model-context (by tbd.ui.core), which is how the page's
own chatbot offers them to its LLM and calls them, the ones of the page being shown (see
`tools`): this ns says what the tools are, and has the WebMCP way of offering them all to an
agent outside the page. A `:read-only? true` tool (one that only reads what `state-providers`
already covers, like list_todos) stays registered here for WebMCP's outside agents, but is left
out of what the page's own chatbot is offered (see tbd.ui.model-context/definitions): that
chatbot is handed the state instead, through `state-providers`. A `:once-per-turn? true` tool
(like move_tic_tac_toe: a game move is the person's to ask for again, not the model's to repeat
on its own) is offered to the chatbot as usual, but only until it has been called once in the
current turn — tbd.ui.events stops offering it, and refuses a second call, for the rest of the
turn (this app's own loop only: it doesn't apply to WebMCP's outside agents, who run their own).
A tool takes its arguments as a map and returns a value or a promise of one: a string, or data
that becomes JSON. Throwing (or rejecting) becomes an error result the agent can read. Input
schemas are JSON Schema, written here: the UI has no Malli to share with the server's."
`prompts` and `resources` carry the same instructions as the chatbot's system prompt
(tbd.agent.prompt), so an outside MCP client is told to act instead of offer, chain calls, etc."
(:require ["@jason.today/webmcp/src/webmcp.js" :as WebMCP]
[clojure.string :as str]
[re-frame.core :as rf]
@@ -281,11 +266,6 @@
(in-order delete-one ids)))
(.then (constantly nil)))))
;; Tic-tac-toe is moves taken in turns: X, then O, on the same board. A person plays on the same
;; board, so a move names the side it is for, and is refused when it is not that side's turn: an
;; agent that lost track of whose turn it is cannot play the person's move (or both sides).
;; Every result says whose turn it is.
(defn- tic-tac-toe-state
"The game as the page shows it: the 9 cells (row by row, cell 0 is the top left; null when
empty, else \"x\" or \"o\"), `turn` (whose move it is, while the game is on), and `status`